diff --git a/LICENSE b/LICENSE
new file mode 100644
--- /dev/null
+++ b/LICENSE
@@ -0,0 +1,30 @@
+Copyright (c) 2015, Henning Thielemann
+
+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 Henning Thielemann 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.lhs b/Setup.lhs
new file mode 100644
--- /dev/null
+++ b/Setup.lhs
@@ -0,0 +1,3 @@
+#!/usr/bin/env runhaskell
+> import Distribution.Simple
+> main = defaultMain
diff --git a/comfort-graph.cabal b/comfort-graph.cabal
new file mode 100644
--- /dev/null
+++ b/comfort-graph.cabal
@@ -0,0 +1,78 @@
+Name:                comfort-graph
+Version:             0.0
+Synopsis:            Graph structure with type parameters for nodes and edges
+Description:
+  This graph structure is based on "Data.Map"
+  and allows any 'Ord' type for nodes
+  and allows directed, undirected and more edge types.
+  There is no need to map nodes to integer numbers.
+  This makes handling in applications much more comfortable,
+  thus the package name.
+  .
+  Currently the package does not contain any advanced algorithm,
+  just the data structure and some manipulation functions.
+  .
+  The edge type can be freely chosen.
+  This allows great flexibility
+  but it is a bit more cumbersome to do in Haskell 98.
+  Examples of edge types:
+  .
+  * @DirEdge@: Edges in a directed graph
+  .
+  * @UndirEdge@: Edges in an undirected graph
+  .
+  * @EitherEdge@: For graphs containing both directed and undirected edges
+  .
+  * You may define an edge type with an additional identifier
+    in order to support multiple edges between the same pair of nodes.
+  .
+  * Using type functions on the node type
+    you may even define an edge type for nodes from a Cartesian product,
+    where only \"horizontal\" and \"vertical\" edges are allowed.
+  .
+  For examples see the @linear-circuit@ package and its tests.
+  The @ResistorCube@ test demonstrates non-integer node types
+  and the @Tree@ test demonstrates multigraphs.
+  .
+  The package is plain Haskell 98.
+  .
+  Related packages:
+  .
+  * @fgl@:
+      standard package for graph processing with many graph algorithms
+      but cumbersome data structure with Int numbered nodes
+Homepage:            http://hub.darcs.net/thielema/comfort-graph
+License:             BSD3
+License-File:        LICENSE
+Author:              Henning Thielemann
+Maintainer:          haskell@henning-thielemann.de
+Category:            Data
+Build-Type:          Simple
+Cabal-Version:       >=1.10
+
+Source-Repository this
+  Tag:         0.0
+  Type:        darcs
+  Location:    http://hub.darcs.net/thielema/comfort-graph
+
+Source-Repository head
+  Type:        darcs
+  Location:    http://hub.darcs.net/thielema/comfort-graph
+
+Library
+  Exposed-Modules:
+    Data.Graph.Comfort
+  Other-Modules:
+    Data.Graph.Comfort.Map
+    Data.Graph.Comfort.TypeConstructor
+    -- ToDo: should be replaced by future version of total-map
+    Data.Graph.Comfort.TotalMap
+  Build-Depends:
+    QuickCheck >=2.5 && <3,
+    containers >=0.4 && <0.6,
+    transformers >=0.4 && <0.5,
+    utility-ht >=0.0.10 && <0.1,
+    base >=4.5 && <5
+  Hs-Source-Dirs:      src
+  Default-Language:    Haskell2010
+  GHC-Options:         -Wall
diff --git a/src/Data/Graph/Comfort.hs b/src/Data/Graph/Comfort.hs
new file mode 100644
--- /dev/null
+++ b/src/Data/Graph/Comfort.hs
@@ -0,0 +1,647 @@
+module Data.Graph.Comfort (
+   -- * types
+   Graph,
+   LabeledNode,
+   LabeledEdge,
+   Edge(from, to),
+   DirEdge(DirEdge),
+   UndirEdge(UndirEdge), undirEdge,
+   EitherEdge(EDirEdge,EUndirEdge),
+
+   -- * construction
+   empty, fromList, fromMap,
+
+   -- * extract large portions of the graph
+   graphMap,
+   nodeLabels, nodeSet, nodes, nodeEdges,
+   edgeLabels, edgeSet, edges,
+
+   -- * queries
+   isEmpty,
+   lookupNode, lookupEdge,
+   adjacentEdges,
+   isLoop,
+   pathExists,
+   isConsistent,
+
+   -- * manipulate labels
+   mapNode, mapNodeWithKey,
+   mapEdge, mapEdgeWithKey,
+   mapNodeWithInOut, InOut,
+   filterEdgeWithKey,
+   traverseNode, traverseEdge, traverse,
+
+   -- * combine graphs
+   checkedZipWith,
+   union,
+
+   -- * manipulate indices
+   Reverse,
+   reverse,
+   reverseEdge,
+   mapKeys,
+   mapMaybeEdgeKeys,
+   mapEdgeKeys,
+
+   -- * insertion and removal
+   deleteNode, deleteNodeSet, deleteEdge,
+   insertNode, insertEdge, insertEdgeSet,
+   ) where
+
+import qualified Data.Graph.Comfort.Map as MapU
+import qualified Data.Graph.Comfort.TotalMap as TMap
+import qualified Data.Graph.Comfort.TypeConstructor as TC
+
+import Data.Functor.Classes (Eq1(eq1), Ord1(compare1), Show1(showsPrec1))
+
+import qualified Data.Set as Set
+import qualified Data.Map as Map
+import qualified Data.Traversable as Trav
+import qualified Data.Foldable as Fold
+import Control.Monad (liftM2)
+import Control.Applicative (Applicative, pure, liftA2, liftA3)
+import Data.Foldable (Foldable, foldMap)
+import Data.Set (Set)
+import Data.Map (Map)
+import Data.Monoid (Monoid, mempty, mappend)
+import Data.Tuple.HT (mapFst, fst3, snd3, thd3, mapFst3, mapThd3)
+
+import qualified Test.QuickCheck as QC
+
+import Prelude hiding (reverse)
+
+
+{-
+For all 'Graph's the 'isConsistent' predicate must be 'True'.
+-}
+newtype Graph edge node edgeLabel nodeLabel =
+   Graph {
+      graphMapWrap ::
+         Map node (InOutMap (TC.Wrap edge) node edgeLabel nodeLabel)
+   } deriving (Eq, Ord)
+
+instance
+   (Edge e, Ord n, Show1 e, Show n, Show el, Show nl) =>
+      Show (Graph e n el nl) where
+   showsPrec prec g =
+      showParen (prec>10) $
+         showString "Graph.fromList " .
+         shows (Map.toList $ nodeLabels g) .
+         showString " " .
+         shows (Map.toList $ edgeLabelsWrap g)
+
+
+isConsistent :: (Ord n, Eq el) => Graph DirEdge n el nl -> Bool
+isConsistent (Graph ns) =
+   foldMap fst3 ns == foldMap thd3 ns
+   &&
+   Set.isSubsetOf
+      (foldMap (foldMap (foldMap Set.singleton) . Map.keys . fst3) ns)
+      (Map.keysSet ns)
+   &&
+   (Fold.and $ flip Map.mapWithKey ns $
+      \n (ins,_nl,outs) ->
+         Fold.all ((n==) . toWrap) (Map.keysSet ins) &&
+         Fold.all ((n==) . fromWrap) (Map.keysSet outs))
+
+
+type LabeledNode n label = (n, label)
+
+
+class (Foldable edge, Ord1 edge) => Edge edge where
+   from, to :: edge node -> node
+
+instance Edge DirEdge where
+   from (DirEdge x _) = x
+   to (DirEdge _ x) = x
+
+instance Edge UndirEdge where
+   from (UndirEdge x _) = x
+   to (UndirEdge _ x) = x
+
+instance Edge EitherEdge where
+   from ee =
+      case ee of
+         EDirEdge   e -> from e
+         EUndirEdge e -> from e
+   to ee =
+      case ee of
+         EDirEdge   e -> to e
+         EUndirEdge e -> to e
+
+
+{-
+class (Edge edge) => ConsEdge edge where
+   {- |
+   The construction of an edge may fail
+   and it is not warranted
+   that @x == from (edge x y)@ or @y == to (edge x y)@.
+   -}
+   edge :: Ord node => node -> node -> Maybe (edge node)
+
+instance ConsEdge DirEdge where
+   edge x y = Just $ DirEdge x y
+
+instance ConsEdge UndirEdge where
+   edge x y = Just $ undirEdge x y
+-}
+
+
+
+type LabeledEdge edge node label = (edge node, label)
+
+
+data DirEdge node = DirEdge node node
+   deriving (Eq, Ord, Show)
+
+data UndirEdge node = UndirEdge node node
+   deriving (Eq, Ord, Show)
+
+undirEdge :: (Ord node) => node -> node -> UndirEdge node
+undirEdge x y =
+   if x<y
+     then UndirEdge x y
+     else UndirEdge y x
+
+data
+   EitherEdge node =
+        EDirEdge (DirEdge node)
+      | EUndirEdge (UndirEdge node)
+   deriving (Eq, Ord, Show)
+
+
+instance Eq1 DirEdge where eq1 = (==)
+instance Ord1 DirEdge where compare1 = compare
+instance Show1 DirEdge where showsPrec1 = showsPrec
+
+instance Eq1 UndirEdge where eq1 = (==)
+instance Ord1 UndirEdge where compare1 = compare
+instance Show1 UndirEdge where showsPrec1 = showsPrec
+
+instance Eq1 EitherEdge where eq1 = (==)
+instance Ord1 EitherEdge where compare1 = compare
+instance Show1 EitherEdge where showsPrec1 = showsPrec
+
+
+instance Functor DirEdge where
+   fmap f (DirEdge x y) = DirEdge (f x) (f y)
+
+instance Foldable DirEdge where
+   foldMap f (DirEdge x y) = mappend (f x) (f y)
+
+instance Foldable UndirEdge where
+   foldMap f (UndirEdge x y) = mappend (f x) (f y)
+
+instance Foldable EitherEdge where
+   foldMap f ee =
+      case ee of
+         EDirEdge   e -> foldMap f e
+         EUndirEdge e -> foldMap f e
+
+instance (QC.Arbitrary n) => QC.Arbitrary (DirEdge n) where
+   arbitrary = liftM2 DirEdge QC.arbitrary QC.arbitrary
+   shrink (DirEdge x y) = map (uncurry DirEdge) $ QC.shrink (x,y)
+
+instance (QC.Arbitrary n, Ord n) => QC.Arbitrary (UndirEdge n) where
+   arbitrary = liftM2 undirEdge QC.arbitrary QC.arbitrary
+   shrink (UndirEdge x y) =
+      Set.toList $ Set.fromList $ map (uncurry undirEdge) $ QC.shrink (x,y)
+
+
+graphMap ::
+   Graph edge node edgeLabel nodeLabel ->
+   Map node (InOutMap edge node edgeLabel nodeLabel)
+graphMap = fmap unwrapInOut . graphMapWrap
+
+nodes ::
+   (Edge edge, Ord node) =>
+   Graph edge node edgeLabel nodeLabel ->
+   [node]
+nodes = Map.keys . graphMapWrap
+
+nodeEdges ::
+   (Edge edge, Ord node) =>
+   Graph edge node edgeLabel nodeLabel ->
+   Map node (Set (edge node), nodeLabel, Set (edge node))
+nodeEdges =
+   fmap
+      (\(ins,n,outs) ->
+         (unwrapSet $ Map.keysSet ins, n, unwrapSet $ Map.keysSet outs)) .
+   graphMapWrap
+
+
+edgeLabels ::
+   (Edge edge, Ord node) =>
+   Graph edge node edgeLabel nodeLabel ->
+   Map (edge node) edgeLabel
+edgeLabels = unwrapMap . edgeLabelsWrap
+
+edgeLabelsWrap ::
+   (Edge edge, Ord node) =>
+   Graph edge node edgeLabel nodeLabel ->
+   Map (TC.Wrap edge node) edgeLabel
+edgeLabelsWrap = foldMap fst3 . graphMapWrap
+
+edgeSet ::
+   (Edge edge, Ord node) =>
+   Graph edge node edgeLabel nodeLabel -> Set (edge node)
+edgeSet = unwrapSet . foldMap (Map.keysSet . fst3) . graphMapWrap
+
+edges ::
+   (Edge edge, Ord node) =>
+   Graph edge node edgeLabel nodeLabel -> [edge node]
+edges = Map.keys . edgeLabels
+
+
+reverse ::
+   (Reverse e, Ord n) =>
+   Graph e n el nl -> Graph e n el nl
+reverse =
+   withWrappedGraph $
+   fmap
+      (\(ins, nl, outs) ->
+         (Map.mapKeys reverseEdgeWrap outs,
+          nl,
+          Map.mapKeys reverseEdgeWrap ins))
+
+reverseEdgeWrap :: Reverse edge => TC.Wrap edge node -> TC.Wrap edge node
+reverseEdgeWrap = TC.Wrap . reverseEdge . TC.unwrap
+
+
+class Edge edge => Reverse edge where
+   reverseEdge :: edge node -> edge node
+
+instance Reverse DirEdge where
+   reverseEdge (DirEdge x y) = DirEdge y x
+
+
+{- |
+The index map must be an injection,
+that is, nodes must not collaps.
+Also the node and edge index maps must be consistent, i.e.
+
+> from (edgeMap e) == nodeMap (from e)
+> to   (edgeMap e) == nodeMap (to   e)
+
+Strictly spoken, we would need the node map only for isolated nodes,
+but we use it for all nodes for simplicity.
+-}
+mapKeys ::
+   (Edge edge1, Ord node0, Ord node1) =>
+   (node0 -> node1) ->
+   (edge0 node0 -> edge1 node1) ->
+   Graph edge0 node0 edgeLabel nodeLabel ->
+   Graph edge1 node1 edgeLabel nodeLabel
+mapKeys f g =
+   withWrappedGraph $
+   fmap
+      (\(ins,nl,outs) ->
+         (Map.mapKeys (TC.Wrap . g . TC.unwrap) ins,
+          nl,
+          Map.mapKeys (TC.Wrap . g . TC.unwrap) outs)) .
+   Map.mapKeysWith (error "Graph.mapKeys: node map is not injective") f
+
+empty :: Graph edge node edgeLabel nodeLabel
+empty = Graph Map.empty
+
+{- |
+The node sets must be disjoint.
+-}
+union ::
+   (Edge edge, Ord node) =>
+   Graph edge node edgeLabel nodeLabel ->
+   Graph edge node edgeLabel nodeLabel ->
+   Graph edge node edgeLabel nodeLabel
+union (Graph ns0) (Graph ns1) =
+   Graph
+      (Map.unionWith (error "Graph.union: node sets overlap") ns0 ns1)
+
+instance
+   (Edge edge, Ord node) =>
+      Monoid (Graph edge node edgeLabel nodeLabel) where
+   mempty = empty
+   mappend = union
+
+
+{- |
+Node and edge sets must be equal.
+-}
+checkedZipWith ::
+   (Edge edge, Ord node) =>
+   MapU.Caller ->
+   (nodeLabel0 -> nodeLabel1 -> nodeLabel2) ->
+   (edgeLabel0 -> edgeLabel1 -> edgeLabel2) ->
+   Graph edge node edgeLabel0 nodeLabel0 ->
+   Graph edge node edgeLabel1 nodeLabel1 ->
+   Graph edge node edgeLabel2 nodeLabel2
+checkedZipWith caller f g (Graph ns0) (Graph ns1) =
+   Graph $
+   MapU.checkedZipWith (caller ++ " node")
+      (\(ins0, n0, outs0) (ins1, n1, outs1) ->
+         (MapU.checkedZipWith (caller ++ " ins") g ins0 ins1,
+          f n0 n1,
+          MapU.checkedZipWith (caller ++ " outs") g outs0 outs1))
+      ns0 ns1
+
+
+nodeLabels :: (Edge e, Ord n) => Graph e n el nl -> Map n nl
+nodeLabels = fmap snd3 . graphMapWrap
+
+lookupEdge :: (Edge e, Ord n) => e n -> Graph e n el nl -> Maybe el
+lookupEdge e (Graph g) =
+   Map.lookup (TC.Wrap e) . thd3 =<< Map.lookup (from e) g
+
+{- |
+Alternative implementation for test:
+-}
+_lookupEdge :: (Edge e, Ord n) => e n -> Graph e n el nl -> Maybe el
+_lookupEdge e (Graph g) =
+   Map.lookup (TC.Wrap e) . fst3 =<< Map.lookup (to e) g
+
+
+isEmpty :: Graph e n el nl -> Bool
+isEmpty = Map.null . graphMapWrap
+
+lookupNode :: (Ord n) => n -> Graph e n el nl -> Maybe nl
+lookupNode n (Graph g) = fmap snd3 $ Map.lookup n g
+
+_pre, suc ::
+   (Edge e, Ord n) =>
+   Graph e n el nl -> n -> [n]
+_pre g n =
+   Set.toList . Set.map fromWrap . Map.keysSet . fst3 .
+   Map.findWithDefault (error "pre: unknown node") n . graphMapWrap $ g
+suc g n =
+   Set.toList . Set.map toWrap . Map.keysSet . thd3 .
+   Map.findWithDefault (error "suc: unknown node") n . graphMapWrap $ g
+
+adjacentEdges ::
+   (Edge e, Ord n) =>
+   Graph e n el nl -> n -> Set (e n)
+adjacentEdges g n =
+   (\(ins,_nl,outs) ->
+      unwrapSet $ Map.keysSet ins `Set.union` Map.keysSet outs) $
+   Map.findWithDefault (error "adjacentEdges: unknown node") n $
+   graphMapWrap g
+
+{-
+In constrast to Map.intersectWith ($), unaffected values are preserved.
+-}
+applyMap :: (Ord k) => Map k (a -> a) -> Map k a -> Map k a
+applyMap f x =
+   Map.union (Map.intersectionWith ($) f x) x
+
+{- |
+Node to be deleted must be contained in the graph.
+-}
+deleteNode ::
+   (Edge e, Ord n) =>
+   n -> Graph e n el nl -> Graph e n el nl
+deleteNode n =
+   withWrappedGraph $ \ns ->
+   case Map.findWithDefault (error "deleteNode: unknown node") n ns of
+      (ins, _nl, outs) ->
+         applyMap (Map.mapKeys fromWrap $ Map.mapWithKey (\e _ -> mapThd3 $ Map.delete e) ins)  $
+         applyMap (Map.mapKeys toWrap   $ Map.mapWithKey (\e _ -> mapFst3 $ Map.delete e) outs) $
+         Map.delete n ns
+
+{- |
+Could be implemented more efficiently.
+-}
+deleteNodeSet ::
+   (Edge e, Ord n) =>
+   Set n -> Graph e n el nl -> Graph e n el nl
+deleteNodeSet delNs g = Set.foldl (flip deleteNode) g delNs
+
+deleteEdge ::
+   (Edge e, Ord n) =>
+   e n -> Graph e n el nl -> Graph e n el nl
+deleteEdge e =
+   withWrappedGraph $
+      Map.adjust (mapThd3 $ Map.delete $ TC.Wrap e) (from e) .
+      Map.adjust (mapFst3 $ Map.delete $ TC.Wrap e) (to e)
+
+filterEdgeWithKey ::
+   (Edge e, Ord n) =>
+   (e n -> el -> Bool) ->
+   Graph e n el nl -> Graph e n el nl
+filterEdgeWithKey f =
+   Graph .
+   fmap
+      (\(ins, nl, outs) ->
+         (Map.filterWithKey (f . TC.unwrap) ins, nl,
+          Map.filterWithKey (f . TC.unwrap) outs)) .
+   graphMapWrap
+
+{- |
+You may only use this for filtering edges
+and use more specialised types as a result.
+You must not alter source and target nodes of edges.
+-}
+mapMaybeEdgeKeys ::
+   (Edge e1, Ord n) =>
+   (e0 n -> Maybe (e1 n)) ->
+   Graph e0 n el nl -> Graph e1 n el nl
+mapMaybeEdgeKeys f =
+   withWrappedGraph $
+   fmap
+      (\(ins, nl, outs) ->
+         (MapU.mapMaybeKeys (fmap TC.Wrap . f . TC.unwrap) ins,
+          nl,
+          MapU.mapMaybeKeys (fmap TC.Wrap . f . TC.unwrap) outs))
+
+mapEdgeKeys ::
+   (Edge e1, Ord n) =>
+   (e0 n -> e1 n) ->
+   Graph e0 n el nl -> Graph e1 n el nl
+mapEdgeKeys f =
+   withWrappedGraph $
+   fmap
+      (\(ins, nl, outs) ->
+         (Map.mapKeys (TC.Wrap . f . TC.unwrap) ins,
+          nl,
+          Map.mapKeys (TC.Wrap . f . TC.unwrap) outs))
+
+{- |
+In the current implementation
+existing nodes are replaced with new labels
+and existing edges are maintained.
+However, I think we should better have an extra function for this purpose
+and you should not rely on this behavior.
+-}
+insertNode ::
+   (Ord n) => n -> nl -> Graph e n el nl -> Graph e n el nl
+insertNode n nl =
+   Graph .
+   Map.insertWith
+      (\_ (ins, _, outs) -> (ins, nl, outs))
+      n (Map.empty, nl, Map.empty) .
+   graphMapWrap
+
+insertEdge ::
+   (Edge e, Ord n) =>
+   e n -> el -> Graph e n el nl -> Graph e n el nl
+insertEdge e el = insertEdgeSet $ Map.singleton e el
+
+{- |
+In the current implementation
+existing edges are replaced with new labels.
+However, I think we should better have an extra function for this purpose
+and you should not rely on this behavior.
+-}
+insertEdgeSet ::
+   (Edge e, Ord n) =>
+   Map (e n) el -> Graph e n el nl -> Graph e n el nl
+insertEdgeSet es =
+   let ess = Map.mapWithKey Map.singleton $ wrapMap es
+   in  withWrappedGraph $
+       applyMap (fmap (\new -> mapFst3 (Map.union new)) $ Map.mapKeysWith Map.union toWrap   ess) .
+       applyMap (fmap (\new -> mapThd3 (Map.union new)) $ Map.mapKeysWith Map.union fromWrap ess)
+
+fromList ::
+   (Edge e, Ord n) =>
+   [LabeledNode n nl] -> [LabeledEdge e n el] -> Graph e n el nl
+fromList ns es =
+   fromMapWrap (Map.fromList ns) $ Map.fromList $ map (mapFst TC.Wrap) es
+
+fromMap ::
+   (Edge e, Ord n) =>
+   Map n nl -> Map (e n) el -> Graph e n el nl
+fromMap ns = fromMapWrap ns . wrapMap
+
+fromMapWrap ::
+   (Edge e, Ord n) =>
+   Map n nl -> Map (TC.Wrap e n) el -> Graph e n el nl
+fromMapWrap ns es =
+   let ess = Map.mapWithKey Map.singleton es
+   in  Graph $
+       TMap.intersectionPartialWith (\ins (outs, nl) -> (ins,nl,outs))
+          (TMap.cons Map.empty $ Map.mapKeysWith Map.union toWrap   ess) $
+       TMap.intersectionPartialWith (,)
+          (TMap.cons Map.empty $ Map.mapKeysWith Map.union fromWrap ess) ns
+
+
+mapNode :: (nl0 -> nl1) -> Graph e n el nl0 -> Graph e n el nl1
+mapNode f =
+   Graph . fmap (\(ins,n,outs) -> (ins, f n, outs)) . graphMapWrap
+
+mapNodeWithKey :: (n -> nl0 -> nl1) -> Graph e n el nl0 -> Graph e n el nl1
+mapNodeWithKey f =
+   Graph .
+   Map.mapWithKey (\n (ins,nl,outs) -> (ins, f n nl, outs)) .
+   graphMapWrap
+
+mapEdge :: (el0 -> el1) -> Graph e n el0 nl -> Graph e n el1 nl
+mapEdge f =
+   Graph . fmap (\(ins,n,outs) -> (fmap f ins, n, fmap f outs)) . graphMapWrap
+
+mapEdgeWithKey :: (e n -> el0 -> el1) -> Graph e n el0 nl -> Graph e n el1 nl
+mapEdgeWithKey f =
+   Graph .
+   fmap (\(ins,n,outs) -> (Map.mapWithKey (f . TC.unwrap) ins, n, Map.mapWithKey (f . TC.unwrap) outs)) .
+   graphMapWrap
+
+nodeSet :: Graph e n el nl -> Set n
+nodeSet = Map.keysSet . graphMapWrap
+
+
+type
+   InOut e n el nl =
+      ([LabeledEdge e n el], LabeledNode n nl, [LabeledEdge e n el])
+
+mapNodeWithInOut ::
+   (Edge e, Ord n) =>
+   (InOut e n el nl0 -> nl1) -> Graph e n el nl0 -> Graph e n el nl1
+mapNodeWithInOut f =
+   Graph .
+   Map.mapWithKey
+      (\n (ins,nl,outs) ->
+         (ins,
+          f (Map.toList $ unwrapMap ins, (n,nl), Map.toList $ unwrapMap outs),
+          outs)) .
+   graphMapWrap
+
+
+{- |
+Same restrictions as in 'traverse'.
+-}
+traverseNode ::
+   (Applicative f, Edge e, Ord n) =>
+   (nl0 -> f nl1) -> Graph e n el nl0 -> f (Graph e n el nl1)
+traverseNode f = traverse f pure
+
+{- |
+Same restrictions as in 'traverse'.
+-}
+traverseEdge ::
+   (Applicative f, Edge e, Ord n) =>
+   (el0 -> f el1) -> Graph e n el0 nl -> f (Graph e n el1 nl)
+traverseEdge f = traverse pure f
+
+{- |
+Don't rely on a particular order of traversal!
+-}
+traverse, _traverseNaive ::
+   (Applicative f, Edge e, Ord n) =>
+   (nl0 -> f nl1) ->
+   (el0 -> f el1) ->
+   Graph e n el0 nl0 -> f (Graph e n el1 nl1)
+traverse fn fe gr =
+   liftA2 fromMap
+      (Trav.traverse fn $ nodeLabels gr)
+      (Trav.traverse fe $ edgeLabels gr)
+
+{-
+Due to the current implementation all edges are accessed twice.
+That is, the actions should be commutative and non-destructive.
+-}
+_traverseNaive fn fe =
+   fmap Graph .
+   Trav.traverse
+      (\(ins,n,outs) ->
+         liftA3 (,,) (Trav.traverse fe ins) (fn n) (Trav.traverse fe outs)) .
+   graphMapWrap
+
+
+isLoop :: (Edge edge, Eq node) => edge node -> Bool
+isLoop e = from e == to e
+
+pathExists ::
+   (Edge edge, Ord node) =>
+   node -> node -> Graph edge node edgeLabel nodeLabel -> Bool
+pathExists src dst =
+   let go gr a =
+          not (isEmpty gr) &&
+          (a==dst || (any (go (deleteNode a gr)) $ suc gr a))
+   in  flip go src
+
+
+-- * Wrap utilities
+
+unwrapMap :: Map (TC.Wrap e n) a -> Map (e n) a
+unwrapMap = Map.mapKeysMonotonic TC.unwrap
+
+wrapMap :: Map (e n) a -> Map (TC.Wrap e n) a
+wrapMap = Map.mapKeysMonotonic TC.Wrap
+
+unwrapSet :: Set (TC.Wrap f a) -> Set (f a)
+unwrapSet = Set.mapMonotonic TC.unwrap
+
+
+type InOutMap e n el nl = (Map (e n) el, nl, Map (e n) el)
+
+unwrapInOut :: InOutMap (TC.Wrap e) n el nl -> InOutMap e n el nl
+unwrapInOut = mapFst3 unwrapMap . mapThd3 unwrapMap
+
+withWrappedGraph ::
+   (Map n0 (InOutMap (TC.Wrap e0) n0 el0 nl0) ->
+    Map n1 (InOutMap (TC.Wrap e1) n1 el1 nl1)) ->
+   Graph e0 n0 el0 nl0 -> Graph e1 n1 el1 nl1
+withWrappedGraph f =
+   Graph . f . graphMapWrap
+
+fromWrap :: (Edge edge) => TC.Wrap edge node -> node
+fromWrap = from . TC.unwrap
+
+toWrap :: (Edge edge) => TC.Wrap edge node -> node
+toWrap   = to   . TC.unwrap
diff --git a/src/Data/Graph/Comfort/Map.hs b/src/Data/Graph/Comfort/Map.hs
new file mode 100644
--- /dev/null
+++ b/src/Data/Graph/Comfort/Map.hs
@@ -0,0 +1,108 @@
+module Data.Graph.Comfort.Map where
+
+import qualified Data.Set as Set
+import qualified Data.Map as Map
+import Data.Set (Set)
+import Data.Map (Map)
+import Data.Tuple.HT (swap)
+import Data.Maybe (mapMaybe)
+
+import qualified Prelude as P
+import Prelude hiding (curry, uncurry, flip)
+
+
+-- | New improved ugly version with caller function name
+type Caller = String
+
+
+checkedLookup ::
+  (Ord k, Show k) => Caller -> Map k v -> k -> v
+checkedLookup c m k =
+  case Map.lookup k m of
+    Nothing ->
+      error $ "checkedLookup error in " ++ c ++ "\n"
+              ++ "key: " ++ show k  ++ "\n"
+              ++ "keys in map:\n" ++ unlines (map show (Map.keys m)) ++ "\n"
+    Just x -> x
+
+{- |
+The set of keys must be equal and this is checked dynamically.
+-}
+checkedZipWith ::
+  (Ord k) =>
+  Caller ->
+  (a -> b -> c) ->
+  Map k a -> Map k b -> Map k c
+checkedZipWith caller f ma mb =
+  if Map.keysSet ma == Map.keysSet mb
+    then Map.intersectionWith f ma mb
+    else error $
+            "checkedZipWith called by function " ++ caller ++
+            ": key sets differ"
+
+
+reverse :: (Ord b) => Map a b -> Map b a
+reverse = Map.fromList . map swap . Map.toList
+
+-- Map.fromSet is available from containers-0.5
+fromSet ::
+   (Ord key) => (key -> a) -> Set key -> Map key a
+fromSet f = Map.fromAscList . map (\k -> (k, f k)) . Set.toAscList
+
+differenceSet ::
+   (Ord key) => Map key a -> Set key -> Map key a
+differenceSet m s = Map.difference m (fromSet (const ()) s)
+
+intersectionSet ::
+   (Ord key) => Map key a -> Set key -> Map key a
+intersectionSet m s = Map.intersection m (fromSet (const ()) s)
+
+
+
+curry ::
+   (Ord k0, Ord k1) =>
+   Caller ->
+   (k -> (k0, k1)) ->
+   Map k a -> Map k0 (Map k1 a)
+curry caller f =
+   Map.unionsWith (Map.unionWith (error $ caller ++ ".curry: duplicate key")) .
+   Map.elems .
+   Map.mapWithKey
+      (\k a ->
+         case f k of
+            (k0, k1) -> Map.singleton k0 $ Map.singleton k1 a)
+
+uncurry ::
+   (Ord k) =>
+   Caller ->
+   (k0 -> k1 -> k) ->
+   Map k0 (Map k1 v) -> Map k v
+uncurry caller f =
+   Map.unionsWith (error $ caller ++ ".uncurry: duplicate key") .
+   Map.elems .
+   Map.mapWithKey (Map.mapKeys . f)
+
+flip ::
+   (Ord k0, Ord k1) =>
+   Map k0 (Map k1 a) -> Map k1 (Map k0 a)
+flip =
+   Map.unionsWith (Map.unionWith (error $ "Map.flip: duplicate key")) .
+   concat .
+   Map.elems .
+   Map.mapWithKey
+      (\k0 ->
+         Map.elems .
+         Map.mapWithKey
+            (\k1 a -> Map.singleton k1 $ Map.singleton k0 a))
+
+
+mapMaybeKeys ::
+   (Ord k1) =>
+   (k0 -> Maybe k1) ->
+   Map k0 a -> Map k1 a
+mapMaybeKeys f =
+   Map.fromList . mapMaybe (\(k,a) -> fmap (P.flip (,) a) $ f k) . Map.toList
+
+
+compose :: (Ord a, Ord b) => Map b c -> Map a b -> Map a c
+compose bc ab = Map.mapMaybe (P.flip Map.lookup bc) ab
diff --git a/src/Data/Graph/Comfort/TotalMap.hs b/src/Data/Graph/Comfort/TotalMap.hs
new file mode 100644
--- /dev/null
+++ b/src/Data/Graph/Comfort/TotalMap.hs
@@ -0,0 +1,34 @@
+-- inspired by total-map
+module Data.Graph.Comfort.TotalMap where
+
+import Control.Applicative (Applicative, pure, (<*>))
+
+import qualified Data.Map as Map
+import Data.Map (Map)
+import Data.Monoid ((<>))
+
+
+data TotalMap k a = TotalMap {deflt :: a, core :: Map k a}
+
+cons :: a -> Map k a -> TotalMap k a
+cons = TotalMap
+
+
+instance Functor (TotalMap k) where
+   fmap f (TotalMap d m) = TotalMap (f d) (fmap f m)
+
+instance (Ord k) => Applicative (TotalMap k) where
+   pure a = TotalMap a Map.empty
+   TotalMap fd fm <*> TotalMap ad am =
+      TotalMap (fd ad) $
+         fmap ($ad) (Map.difference fm am) <>
+         fmap (fd$) (Map.difference am fm) <>
+         Map.intersectionWith ($) fm am
+
+intersectionPartialWith ::
+   (Ord k) =>
+   (a -> b -> c) -> TotalMap k a -> Map k b -> Map k c
+intersectionPartialWith f (TotalMap ad am) bm =
+   Map.intersectionWith f am bm
+   `Map.union`
+   fmap (f ad) bm
diff --git a/src/Data/Graph/Comfort/TypeConstructor.hs b/src/Data/Graph/Comfort/TypeConstructor.hs
new file mode 100644
--- /dev/null
+++ b/src/Data/Graph/Comfort/TypeConstructor.hs
@@ -0,0 +1,30 @@
+-- similar to prelude-extras
+module Data.Graph.Comfort.TypeConstructor (
+   Wrap(Wrap, unwrap),
+   ) where
+
+import Data.Functor.Classes (Eq1(eq1), Ord1(compare1), Show1(showsPrec1))
+
+import Data.Traversable (Traversable, traverse)
+import Data.Foldable (Foldable, foldMap)
+
+
+newtype Wrap f a = Wrap {unwrap :: f a}
+
+instance (Eq1 f, Eq a) => Eq (Wrap f a) where
+   Wrap x == Wrap y  =  eq1 x y
+
+instance (Ord1 f, Ord a) => Ord (Wrap f a) where
+   compare (Wrap x) (Wrap y)  =  compare1 x y
+
+instance (Show1 f, Show a) => Show (Wrap f a) where
+   showsPrec p (Wrap x)  =  showsPrec1 p x
+
+instance Functor f => Functor (Wrap f) where
+   fmap f (Wrap a) = Wrap (fmap f a)
+
+instance Foldable f => Foldable (Wrap f) where
+   foldMap f (Wrap a) = foldMap f a
+
+instance Traversable f => Traversable (Wrap f) where
+   traverse f (Wrap a) = fmap Wrap $ traverse f a
