diff --git a/CHANGELOG.md b/CHANGELOG.md
--- a/CHANGELOG.md
+++ b/CHANGELOG.md
@@ -1,5 +1,11 @@
 # Changelog
 
+## 0.1.2
+
+### [Added]
+
+- `--collapse-modules` option to collapse entire modules into a single node
+
 ## 0.1.1
 
 ### [Changed]
diff --git a/calligraphy.cabal b/calligraphy.cabal
--- a/calligraphy.cabal
+++ b/calligraphy.cabal
@@ -1,6 +1,6 @@
 cabal-version:   2.4
 name:            calligraphy
-version:         0.1.1
+version:         0.1.2
 license:         BSD-3-Clause
 build-type:      Simple
 license-file:    LICENSE
@@ -44,9 +44,9 @@
     Calligraphy.Compat.Debug
     Calligraphy.Compat.GHC
     Calligraphy.Compat.Lib
-    Calligraphy.Phases.Collapse
     Calligraphy.Phases.DependencyFilter
     Calligraphy.Phases.EdgeCleanup
+    Calligraphy.Phases.NodeFilter
     Calligraphy.Phases.Parse
     Calligraphy.Phases.Render
     Calligraphy.Phases.Search
diff --git a/src/Calligraphy.hs b/src/Calligraphy.hs
--- a/src/Calligraphy.hs
+++ b/src/Calligraphy.hs
@@ -5,9 +5,9 @@
 
 import Calligraphy.Compat.Debug (ppHieFile)
 import qualified Calligraphy.Compat.GHC as GHC
-import Calligraphy.Phases.Collapse
 import Calligraphy.Phases.DependencyFilter
 import Calligraphy.Phases.EdgeCleanup
+import Calligraphy.Phases.NodeFilter
 import Calligraphy.Phases.Parse
 import Calligraphy.Phases.Render
 import Calligraphy.Phases.Search
@@ -50,18 +50,19 @@
 
   (parsePhaseDebug, cgParsed) <- either (printDie . ppParseError) pure (parseHieFiles hieFiles)
   debug dumpLexicalTree $ ppParsePhaseDebugInfo parsePhaseDebug
-  let cgCollapsed = collapse collapseConfig cgParsed
+  let cgCollapsed = filterNodes nodeFilterConfig cgParsed
   cgDependencyFiltered <- either (printDie . ppFilterError) pure $ dependencyFilter dependencyFilterConfig cgCollapsed
   let cgCleaned = cleanupEdges edgeFilterConfig cgDependencyFiltered
   debug dumpFinal $ ppCallGraph cgCleaned
 
-  let txt = runPrinter $ render renderConfig cgCleaned
+  let renderConfig' = renderConfig {clusterModules = clusterModules renderConfig && not (collapseModules nodeFilterConfig)}
+      txt = runPrinter $ render renderConfig' cgCleaned
 
   output outputConfig txt
 
 data AppConfig = AppConfig
   { searchConfig :: SearchConfig,
-    collapseConfig :: CollapseConfig,
+    nodeFilterConfig :: NodeFilterConfig,
     dependencyFilterConfig :: DependencyFilterConfig,
     edgeFilterConfig :: EdgeCleanupConfig,
     renderConfig :: RenderConfig,
@@ -78,7 +79,7 @@
 pConfig :: Parser AppConfig
 pConfig =
   AppConfig <$> pSearchConfig
-    <*> pCollapseConfig
+    <*> pNodeFilterConfig
     <*> pDependencyFilterConfig
     <*> pEdgeCleanupConfig
     <*> pRenderConfig
diff --git a/src/Calligraphy/Compat/Debug.hs b/src/Calligraphy/Compat/Debug.hs
--- a/src/Calligraphy/Compat/Debug.hs
+++ b/src/Calligraphy/Compat/Debug.hs
@@ -77,15 +77,15 @@
     forM_ (Map.toList ids) $ \(idn, GHC.IdentifierDetails _ idnDetails) -> do
       ppIdentifier idn
       indent $ forM_ idnDetails $ strLn . GHC.showSDocOneLine (GHC.initSDocContext GHC.unsafeGlobalDynFlags GHC.defaultUserStyle) . GHC.ppr
-    forM_ anns $ strLn . show
+    forM_ anns $ showLn
   indent $ mapM_ ppAst children
 #else
 ppAst (GHC.Node (GHC.NodeInfo anns _ ids) spn children) = do
   strLn (showSpan spn)
   forM_ (Map.toList ids) $ \(idn, GHC.IdentifierDetails _ idnDetails) -> do
     ppIdentifier idn
-    indent $ forM_ idnDetails $ strLn . show
-  forM_ anns $ strLn . show
+    indent $ forM_ idnDetails showLn
+  mapM_ showLn anns
   indent $ mapM_ ppAst children
 #endif
 
diff --git a/src/Calligraphy/Compat/GHC.hs b/src/Calligraphy/Compat/GHC.hs
--- a/src/Calligraphy/Compat/GHC.hs
+++ b/src/Calligraphy/Compat/GHC.hs
@@ -39,6 +39,8 @@
     srcSpanStartLine,
     srcSpanEndCol,
     srcSpanEndLine,
+    srcLocCol,
+    srcLocLine,
   )
 where
 
diff --git a/src/Calligraphy/Compat/Lib.hs b/src/Calligraphy/Compat/Lib.hs
--- a/src/Calligraphy/Compat/Lib.hs
+++ b/src/Calligraphy/Compat/Lib.hs
@@ -12,7 +12,7 @@
     isMinimalNode,
     isDerivingNode,
     showAnns,
-    spanSpans,
+    mergeSpans,
     isPointSpan,
   )
 where
@@ -99,8 +99,8 @@
 
 #endif
 
-spanSpans :: Span -> Span -> Span
-spanSpans sp1 sp2 =
+mergeSpans :: Span -> Span -> Span
+mergeSpans sp1 sp2 =
   mkRealSrcSpan
     ( min
         (realSrcSpanStart sp1)
diff --git a/src/Calligraphy/Phases/Collapse.hs b/src/Calligraphy/Phases/Collapse.hs
deleted file mode 100644
--- a/src/Calligraphy/Phases/Collapse.hs
+++ /dev/null
@@ -1,86 +0,0 @@
-{-# LANGUAGE RecordWildCards #-}
-
--- | This modules manages the two ways we remove nodes from a graph; collapsing and hiding.
---
--- Collapsing means folding a node's descendants into itself, merging all incoming and outcoming edges.
---
--- Hiding means removing a node (and its descendants), moving the edges into the node's parent, if a parent exist.
---
--- Since these are essentially the same thing from different perspectives, they are handled by the same module.
-module Calligraphy.Phases.Collapse (collapse, CollapseConfig, pCollapseConfig) where
-
-import Calligraphy.Util.Types
-import Control.Monad.State
-import Data.EnumMap (EnumMap)
-import qualified Data.EnumMap as EnumMap
-import Data.Maybe (catMaybes)
-import Data.Tree
-import Options.Applicative
-
-data Mode = Show | Collapse | Hide
-  deriving (Eq, Show)
-
-data CollapseConfig = CollapseConfig
-  { hideLocals :: Bool,
-    collapseClasses :: Mode,
-    collapseData :: Mode,
-    collapseValues :: Mode,
-    collapseConstructors :: Mode,
-    hideRecords :: Bool
-  }
-
-pCollapseConfig :: Parser CollapseConfig
-pCollapseConfig =
-  CollapseConfig
-    <$> switch (long "exports-only" <> long "hide-local-bindings" <> help "Remove all non-exported bindings, merging all edges into its parent, if one exist.")
-    <*> pMode "classes" "Remove all class nodes's children, merging the children's edges into itself." "Remove all class nodes and their children."
-    <*> pMode "data" "Remove all data nodes's children, merging the children's edges into itself." "Remove all data nodes and their children, merging all edges into the data node's parent, if one exists."
-    <*> pMode "values" "Remove all value nodes's children, merging the children's edges into itself." "Remove all value nodes and their children, merging all edges into the value node's parent, if one exists."
-    <*> pMode "constructors" "Remove all constructor nodes's children, merging the children's edges into itself." "Remove all constructor nodes and their children, merging all edges into the constructor node's parent, if one exists."
-    <*> flag False True (long "hide-records" <> help "Remove all record nodes.")
-  where
-    pMode :: String -> String -> String -> Parser Mode
-    pMode flagName collapseHelp hideHelp =
-      flag' Collapse (long ("collapse-" <> flagName) <> help collapseHelp)
-        <|> flag' Hide (long ("hide-" <> flagName) <> help hideHelp)
-        <|> pure Show
-
-collapse :: CollapseConfig -> CallGraph -> CallGraph
-collapse CollapseConfig {..} (CallGraph modules calls types) =
-  let (modules', reps) = flip runState mempty $ (traverse . modForest) (fmap catMaybes . traverse (go Nothing)) modules
-   in CallGraph modules' (rekeyCalls reps calls) (rekeyCalls reps types)
-  where
-    shouldCollapse :: Decl -> Bool
-    shouldCollapse decl = case declType decl of
-      ValueDecl -> collapseValues == Collapse
-      ClassDecl -> collapseClasses == Collapse
-      ConDecl -> collapseConstructors == Collapse
-      DataDecl -> collapseData == Collapse
-      _ -> False
-
-    shouldHide :: Decl -> Bool
-    shouldHide decl = typ (declType decl) || (hideLocals && not (declExported decl))
-      where
-        typ ClassDecl = collapseClasses == Hide
-        typ DataDecl = collapseData == Hide
-        typ ValueDecl = collapseValues == Hide
-        typ ConDecl = collapseConstructors == Hide
-        typ RecDecl = hideRecords
-
-    go :: Maybe Decl -> Tree Decl -> State (EnumMap Key Key) (Maybe (Tree Decl))
-    go mparent node@(Node decl children)
-      | shouldHide decl = do
-          forM_ mparent $ \parent ->
-            forM_ node $ \child -> assoc (declKey child) (declKey parent)
-          pure Nothing
-      | shouldCollapse decl = do
-          forM_ node $ \child ->
-            assoc (declKey child) (declKey decl)
-          pure $ Just $ Node decl []
-      | otherwise = do
-          assoc (declKey decl) (declKey decl)
-          children' <- catMaybes <$> mapM (go (Just decl)) children
-          pure $ Just $ Node decl children'
-
-    assoc :: Key -> Key -> State (EnumMap Key Key) ()
-    assoc key rep = modify (EnumMap.insert key rep)
diff --git a/src/Calligraphy/Phases/DependencyFilter.hs b/src/Calligraphy/Phases/DependencyFilter.hs
--- a/src/Calligraphy/Phases/DependencyFilter.hs
+++ b/src/Calligraphy/Phases/DependencyFilter.hs
@@ -134,7 +134,7 @@
 resolveNames :: Module -> Map String (EnumSet Key)
 resolveNames (Module modName _ forest) =
   flip execState mempty $
-    flip (traverse . traverse) forest $
+    flip forestT forest $
       \(Decl name key _ _ _ _) ->
         modify $
           Map.insertWith (<>) (modName <> "." <> name) (EnumSet.singleton key)
diff --git a/src/Calligraphy/Phases/NodeFilter.hs b/src/Calligraphy/Phases/NodeFilter.hs
new file mode 100644
--- /dev/null
+++ b/src/Calligraphy/Phases/NodeFilter.hs
@@ -0,0 +1,108 @@
+{-# LANGUAGE RecordWildCards #-}
+
+-- | This modules manages the two ways we remove nodes from a graph; collapsing and hiding.
+--
+-- Collapsing means absorbing a node's descendants into itself, including all edges.
+--
+-- Hiding means removing a node (and its descendants), moving the edges to the node's parent, if a parent exist.
+--
+-- There's also the special option --collapse-modules.
+-- It's undeniably a little hacky, but for now this is the best home for that functionality.
+-- Functionality-wise, it's still essentially just collapsing nodes into one another.
+-- The thing that makes it hacky is that it then uses a value node to represent a module.
+-- This is not actually a huge deal, because no other module actually cares about the node type, but it's something to watch out for.
+-- There's more design discussion on https://github.com/jonascarpay/calligraphy/pull/5
+module Calligraphy.Phases.NodeFilter (filterNodes, NodeFilterConfig (..), pNodeFilterConfig) where
+
+import Calligraphy.Util.Types
+import Control.Monad.State
+import Data.EnumMap (EnumMap)
+import qualified Data.EnumMap as EnumMap
+import Data.Maybe (catMaybes)
+import Data.Tree
+import Options.Applicative
+
+data Mode = Show | Collapse | Hide
+  deriving (Eq, Show)
+
+data NodeFilterConfig = NodeFilterConfig
+  { hideLocals :: Bool,
+    collapseModules :: Bool,
+    collapseClasses :: Mode,
+    collapseData :: Mode,
+    collapseValues :: Mode,
+    collapseConstructors :: Mode,
+    hideRecords :: Bool
+  }
+
+pNodeFilterConfig :: Parser NodeFilterConfig
+pNodeFilterConfig =
+  NodeFilterConfig
+    <$> switch (long "exports-only" <> long "hide-local-bindings" <> help "Remove all non-exported bindings, merging all edges into its parent, if one exist.")
+    <*> switch (long "collapse-modules" <> help "Collapse all nodes into a single node per module.")
+    <*> pMode "classes" "class"
+    <*> pMode "data" "data"
+    <*> pMode "values" "value"
+    <*> pMode "constructors" "constructor"
+    <*> flag False True (long "hide-records" <> help "Remove all record nodes.")
+  where
+    pMode :: String -> String -> Parser Mode
+    pMode flagName helpName =
+      flag' Collapse (long ("collapse-" <> flagName) <> help collapseHelp)
+        <|> flag' Hide (long ("hide-" <> flagName) <> help hideHelp)
+        <|> pure Show
+      where
+        collapseHelp = "Remove all " <> helpName <> " nodes's children, merging the children's edges into itself."
+        hideHelp = "Remove all " <> helpName <> " nodes and their children."
+
+filterNodes :: NodeFilterConfig -> CallGraph -> CallGraph
+filterNodes NodeFilterConfig {..} (CallGraph modules calls types) =
+  let (modules', reps) =
+        flip runState mempty $
+          forM modules $
+            if collapseModules
+              then collapseModule
+              else modForest (fmap catMaybes . traverse (go Nothing))
+   in CallGraph modules' (rekeyCalls reps calls) (rekeyCalls reps types)
+  where
+    collapseModule :: Module -> State (EnumMap Key Key) Module
+    collapseModule (Module modname path []) = pure $ Module modname path []
+    collapseModule (Module modname path forest@(Node rep _ : _)) = do
+      let repKey = declKey rep
+      forT_ forestT forest $ \decl -> assoc (declKey decl) repKey
+      pure $ Module modname path [Node (Decl modname repKey mempty True ValueDecl (Loc 1 1)) []]
+
+    shouldCollapse :: Decl -> Bool
+    shouldCollapse decl = case declType decl of
+      ValueDecl -> collapseValues == Collapse
+      ClassDecl -> collapseClasses == Collapse
+      ConDecl -> collapseConstructors == Collapse
+      DataDecl -> collapseData == Collapse
+      _ -> False
+
+    shouldHide :: Decl -> Bool
+    shouldHide decl = typ (declType decl) || (hideLocals && not (declExported decl))
+      where
+        typ ClassDecl = collapseClasses == Hide
+        typ DataDecl = collapseData == Hide
+        typ ValueDecl = collapseValues == Hide
+        typ ConDecl = collapseConstructors == Hide
+        typ RecDecl = hideRecords
+
+    go :: Maybe Decl -> Tree Decl -> State (EnumMap Key Key) (Maybe (Tree Decl))
+    go mparent node@(Node decl children)
+      | shouldHide decl = do
+          forM_ mparent $ \parent ->
+            forM_ node $ \child -> assoc (declKey child) (declKey parent)
+          pure Nothing
+      | shouldCollapse decl = do
+          forM_ node $ \child ->
+            assoc (declKey child) (declKey decl)
+          pure $ Just $ Node decl []
+      | otherwise = do
+          assoc (declKey decl) (declKey decl)
+          children' <- catMaybes <$> mapM (go (Just decl)) children
+          pure $ Just $ Node decl children'
+
+    assoc :: Key -> Key -> State (EnumMap Key Key) ()
+    assoc key rep = modify (EnumMap.insert key rep)
diff --git a/src/Calligraphy/Phases/Parse.hs b/src/Calligraphy/Phases/Parse.hs
--- a/src/Calligraphy/Phases/Parse.hs
+++ b/src/Calligraphy/Phases/Parse.hs
@@ -1,3 +1,4 @@
+{-# LANGUAGE BangPatterns #-}
 {-# LANGUAGE DerivingStrategies #-}
 {-# LANGUAGE LambdaCase #-}
 {-# LANGUAGE ScopedTypeVariables #-}
@@ -12,7 +13,7 @@
 where
 
 import qualified Calligraphy.Compat.GHC as GHC
-import Calligraphy.Compat.Lib (isDerivingNode, isInlineNode, isInstanceNode, isMinimalNode, isTypeSignatureNode, sourceInfo, spanSpans)
+import Calligraphy.Compat.Lib (isDerivingNode, isInlineNode, isInstanceNode, isMinimalNode, isTypeSignatureNode, mergeSpans, sourceInfo)
 import qualified Calligraphy.Compat.Lib as GHC
 import Calligraphy.Util.LexTree (LexTree, TreeError (..), foldLexTree)
 import qualified Calligraphy.Util.LexTree as LT
@@ -22,7 +23,6 @@
 import Control.Monad.State
 import Data.Array (Array)
 import qualified Data.Array as Array
-import Data.Bifunctor (first)
 import Data.EnumMap (EnumMap)
 import qualified Data.EnumMap as EnumMap
 import Data.EnumSet (EnumSet)
@@ -32,87 +32,77 @@
 import Data.Map (Map)
 import qualified Data.Map as M
 import qualified Data.Map as Map
+import Data.Semigroup
 import Data.Set (Set)
 import qualified Data.Set as Set
-import Data.Tree (Forest)
-import qualified Data.Tree as Tree
-
--- TODO This can be faster by storing intermediate restuls, but that has proven tricky to get right.
-resolveTypes :: Array GHC.TypeIndex GHC.HieTypeFlat -> EnumMap GHC.TypeIndex (EnumSet GHCKey)
-resolveTypes typeArray = EnumMap.fromList [(ix, evalState (go ix) mempty) | ix <- Array.indices typeArray]
-  where
-    keys :: GHC.HieType a -> EnumSet GHCKey
-    keys (GHC.HTyConApp (GHC.IfaceTyCon name _) _) = EnumSet.singleton (ghcNameKey name)
-    keys (GHC.HForAllTy ((name, _), _) _) = EnumSet.singleton (ghcNameKey name)
-    -- These are variables, which we ignore, but it can't hurt
-    keys (GHC.HTyVarTy name) = EnumSet.singleton (ghcNameKey name)
-    keys _ = mempty
-    go :: GHC.TypeIndex -> State (EnumSet GHC.TypeIndex) (EnumSet GHCKey)
-    go current =
-      gets (EnumSet.member current) >>= \case
-        True -> pure mempty
-        False -> do
-          modify (EnumSet.insert current)
-          let ty = typeArray Array.! current
-          mappend (keys ty) . mconcat <$> mapM go (Foldable.toList ty)
-
-type GHCDecl = (DeclType, GHC.Span, GHC.Name, Loc)
+import Data.Tree (Forest, Tree (..))
 
-data Collect = Collect
-  { _decls :: [GHCDecl],
-    _uses :: [(GHC.RealSrcLoc, GHCKey)],
-    _types :: EnumMap GHCKey (EnumSet GHCKey)
+-- | A declaration extracted from the source code.
+--
+-- A single symbol can apparently declare a name multiple times in the same place, with multiple distinct keys D:
+-- This happens, for example, with default methods; the name refers to both the method name and the default implementation's name.
+-- We have to account for that to _some_ degree, which is why keys is a set.
+-- The actual resolution of these happens wit 'dedup' in mkForest
+data RawDecl = RawDecl
+  { _rdName :: !String,
+    rdKeys :: !(EnumSet GHCKey),
+    _rdTyp :: !DeclType,
+    rdStart :: !Loc,
+    rdEnd :: !Loc
   }
 
-newtype ParseError = TreeError (TreeError GHC.RealSrcLoc (DeclType, Name, Loc))
+data ParseError = TreeError
+  { _peModuleName :: String,
+    _peModulePath :: FilePath,
+    _peError :: TreeError Loc RawDecl
+  }
 
 ppParseError :: Prints ParseError
-ppParseError (TreeError err) = ppTreeError err
+ppParseError (TreeError str path err) = do
+  strLn $ "Parse error in module " <> str <> " (" <> path <> ")"
+  indent $ ppTreeError err
   where
-    ppTreeError :: Prints (TreeError GHC.RealSrcLoc (DeclType, Name, Loc))
-    ppTreeError (InvalidBounds l (ty, nm, _) r) = strLn "Invalid bounds:" >> indent (ppLocNode l r ty nm)
-    ppTreeError (OverlappingBounds (ty, nm, _) (ty', nm', _) l r) = do
-      strLn $ "OverlappingBounds bounds: (" <> show (l, r) <> ")"
-      indent $ do
-        strLn $ showName nm <> " (" <> show ty <> ")"
-        strLn $ showName nm' <> " (" <> show ty' <> ")"
+    ppTreeError :: Prints (TreeError Loc RawDecl)
+    ppTreeError (InvalidBounds l decl r) = do
+      strLn $ "Invalid bounds " <> show (l, r) <> "while inserting"
+      indent $ ppRawDecl decl
+    ppTreeError (OverlappingBounds a b l r) = do
+      strLn $ "Clashing bounds: (" <> show (l, r) <> ")"
+      strLn "Node 1:"
+      indent $ ppRawDecl a
+      strLn "Node 2:"
+      indent $ ppRawDecl b
     ppTreeError MidSplit = strLn "MidSplit"
-    ppTreeError (LexicalError l (ty, nm, _) r t) = do
-      strLn "Lexical error"
+    ppTreeError (LexicalError l decl r t) = do
+      strLn "Lexical error while inserting"
+      strLn "Node:"
+      indent $ ppRawDecl decl
+      strLn "Bounds:"
+      indent $ showLn (l, r)
+      strLn "Tree:"
       indent $ do
-        ppLocNode l r ty nm
         ppLexTree t
 
-showName :: Name -> String
-showName (Name name keys) = name <> "    " <> show (EnumSet.toList keys)
-
-ppLocNode :: GHC.RealSrcLoc -> GHC.RealSrcLoc -> DeclType -> Name -> Printer ()
-ppLocNode l r typ name = strLn $ showName name <> " (" <> show typ <> ") " <> show l <> " " <> show r
+ppRawDecl :: Prints RawDecl
+ppRawDecl (RawDecl name keys typ st end) = do
+  strLn name
+  indent $ do
+    strLn $ "Type: " <> show typ
+    strLn $ "Span: " <> show (st, end)
+    strLn $ "Keys: " <> unwords (show <$> EnumSet.toList keys)
 
-ppLexTree :: Prints (LexTree GHC.RealSrcLoc (DeclType, Name, Loc))
-ppLexTree = foldLexTree (pure ()) $ \ls l (typ, name, _loc) m r rs -> do
+ppLexTree :: Prints (LexTree Loc RawDecl)
+ppLexTree = foldLexTree (pure ()) $ \ls l decl m r rs -> do
   ls
-  ppLocNode l r typ name
+  showLn (l, r)
+  ppRawDecl decl
   indent m
   rs
 
--- A single symbol can apparently declare a name multiple times in the same place, with multiple distinct keys D:
-data Name = Name
-  { _nameString :: String,
-    nameKeys :: EnumSet GHCKey
-  }
-  deriving (Eq, Ord)
-
-mkName :: GHC.Name -> Name
-mkName nm = Name (GHC.getOccString nm) (EnumSet.singleton $ ghcNameKey nm)
-
 ghcNameKey :: GHC.Name -> GHCKey
 ghcNameKey = GHCKey . GHC.getKey . GHC.nameUnique
 
--- TODO rename, clean up
-newtype ParsePhaseDebugInfo = ParsePhaseDebugInfo
-  { modulesLexTrees :: [(String, LexTree GHC.RealSrcLoc (DeclType, Name, Loc))]
-  }
+newtype ParsePhaseDebugInfo = ParsePhaseDebugInfo {modulesLexTrees :: [(String, LexTree Loc RawDecl)]}
 
 ppParsePhaseDebugInfo :: Prints ParsePhaseDebugInfo
 ppParsePhaseDebugInfo (ParsePhaseDebugInfo mods) = forM_ mods $ \(modName, ltree) -> do
@@ -125,122 +115,154 @@
     _pfDecls :: Forest Decl,
     _pfCalls :: Set (GHCKey, GHCKey),
     _pfTypings :: EnumMap GHCKey (EnumSet GHCKey),
-    _pfDebugTree :: LexTree GHC.RealSrcLoc (DeclType, Name, Loc)
+    _pfDebugTree :: LexTree Loc RawDecl
   }
 
+-- | Assigns and maintains a mapping of GHCKeys to Key
+type HieParse a = StateT (Key, EnumMap GHCKey Key) (Either ParseError) a
+
 parseHieFiles ::
   [GHC.HieFile] ->
   Either ParseError (ParsePhaseDebugInfo, CallGraph)
-parseHieFiles files = do
-  (parsed, (_, keymap)) <- runStateT (mapM parseFile files) (0, mempty)
-  let (mods, debugs, calls, typings) = unzip4 (fmap (\(ParsedFile name path forest call typing ltree) -> (Module name path forest, (name, ltree), call, typing)) parsed)
-      typeEdges = rekeyCalls keymap . Set.fromList $ do
-        (term, types) <- EnumMap.toList (mconcat typings)
-        typ <- EnumSet.toList types
-        pure (term, typ)
-  pure (ParsePhaseDebugInfo debugs, CallGraph mods (rekeyCalls keymap (mconcat calls)) typeEdges)
+parseHieFiles files = (\(parsed, (_, keymap)) -> mkCallGraph parsed keymap) <$> runStateT (mapM parseHieFile files) (Key 0, mempty)
   where
-    parseFile ::
-      GHC.HieFile ->
-      StateT
-        (Int, EnumMap GHCKey Key)
-        (Either ParseError)
-        ParsedFile
-    parseFile file@(GHC.HieFile filepath mdl _ _ avails _) = do
-      Collect decls uses types <- lift $ collect file
-      tree <- lift $ structure decls
-      let calls :: Set (GHCKey, GHCKey) = flip foldMap uses $ \(loc, callee) ->
-            case LT.lookup loc tree of
-              Nothing -> mempty
-              Just (_, callerName, _) -> Set.singleton (nameKey callerName, callee)
-      let exportKeys = EnumSet.fromList $ fmap ghcNameKey $ avails >>= GHC.availNames
-      forest <- rekey exportKeys (deduplicate tree)
-      pure $ ParsedFile (GHC.moduleNameString (GHC.moduleName mdl)) filepath forest calls types tree
-    nameKey :: Name -> GHCKey
-    nameKey = EnumSet.findMin . nameKeys
+    mkCallGraph :: [ParsedFile] -> EnumMap GHCKey Key -> (ParsePhaseDebugInfo, CallGraph)
+    mkCallGraph parsed keymap =
+      let (mods, debugs, calls, typings) = unzip4 (fmap (\(ParsedFile name path decls call typing ltree) -> (Module name path decls, (name, ltree), call, typing)) parsed)
+          typeEdges = rekeyCalls keymap . Set.fromList $ do
+            (term, types) <- EnumMap.toList (mconcat typings)
+            typ <- EnumSet.toList types
+            pure (term, typ)
+       in (ParsePhaseDebugInfo debugs, CallGraph mods (rekeyCalls keymap (mconcat calls)) typeEdges)
 
-rekey :: forall m. Monad m => EnumSet GHCKey -> NameTree -> StateT (Int, EnumMap GHCKey Key) m (Forest Decl)
-rekey exports = go
+parseHieFile :: GHC.HieFile -> HieParse ParsedFile
+parseHieFile file@(GHC.HieFile filepath mdl _ _ avails _) = do
+  lextree <- either (throwError . TreeError modname filepath) pure $ structure decls
+  let calls = resolveCalls (fmap (EnumSet.findMin . rdKeys) lextree)
+  forest <- forestT (mkDecl exportKeys) (mkForest lextree)
+  pure $ ParsedFile modname filepath forest calls types lextree
   where
-    fresh :: StateT (Int, EnumMap GHCKey Key) m Key
-    fresh = state $ \(n, m) -> (Key n, (n + 1, m))
-    assoc :: Key -> GHCKey -> StateT (Int, EnumMap GHCKey Key) m ()
-    assoc key ghckey = modify $ fmap (EnumMap.insert ghckey key)
-    go :: NameTree -> StateT (Int, EnumMap GHCKey Key) m (Forest Decl)
-    go (NameTree nt) = forM (Map.toList nt) $ \(name, (ghckeys, typ, sub, mloc)) -> do
+    modname = GHC.moduleNameString (GHC.moduleName mdl)
+    exportKeys = EnumSet.fromList $ fmap ghcNameKey $ avails >>= GHC.availNames
+    Collect decls useSites types = collect file
+
+    resolveCalls :: LexTree Loc GHCKey -> Set (GHCKey, GHCKey)
+    resolveCalls lextree = flip foldMap useSites $ \(loc, callee) ->
+      case LT.lookup loc lextree of
+        Nothing -> mempty
+        Just rep -> Set.singleton (rep, callee)
+
+    mkForest :: LexTree Loc RawDecl -> Forest RawDecl
+    mkForest = over forestT fromKV . dedup . over forestT toKV . LT.toForest
+      where
+        toKV (_, RawDecl name keys typ s e, _) = (name, (keys, Max typ, First s, First e))
+        fromKV (name, (keys, Max typ, First s, First e)) = RawDecl name keys typ s e
+
+    -- TODO this is the only part that touches the state, maybe it's worth lifting it out
+    mkDecl :: EnumSet GHCKey -> RawDecl -> HieParse Decl
+    mkDecl exportSet (RawDecl str ghcKeys typ start _) = do
       key <- fresh
-      forM_ (EnumSet.toList ghckeys) (assoc key)
-      sub' <- go sub
-      let exported = any (flip EnumSet.member exports) (EnumSet.toList ghckeys)
-      pure $ Tree.Node (Decl name key ghckeys exported typ mloc) sub'
+      forM_ (EnumSet.toList ghcKeys) (assoc key)
+      let exported = any (flip EnumSet.member exportSet) (EnumSet.toList ghcKeys)
+      pure $ Decl str key ghcKeys exported typ start
 
-newtype NameTree = NameTree (Map String (EnumSet GHCKey, DeclType, NameTree, Loc))
+    fresh :: HieParse Key
+    fresh = state $ \(Key n, m) -> (Key n, (Key (n + 1), m))
 
-instance Semigroup NameTree where
-  NameTree ta <> NameTree tb = NameTree $ Map.unionWith f ta tb
-    where
-      f (ks, typ, sub, loc) (ks', _, sub', _) = (ks <> ks', typ, sub <> sub', loc)
+    assoc :: Key -> GHCKey -> HieParse ()
+    assoc key ghckey = modify $ fmap (EnumMap.insert ghckey key)
 
-instance Monoid NameTree where mempty = NameTree mempty
+dedup :: (Ord k, Semigroup v) => Forest (k, v) -> Forest (k, v)
+dedup = fromDedup . toDedup
+  where
+    fromDedup = fmap (\(k, (v, d)) -> Node (k, v) (fromDedup d)) . Map.toList . unDedup
+    toDedup = Dedup . Map.fromListWith (<>) . fmap (\(Node (k, v) f) -> (k, (v, toDedup f)))
 
-deduplicate :: LexTree GHC.RealSrcLoc (DeclType, Name, Loc) -> NameTree
-deduplicate = LT.foldLexTree mempty $ \l _ (typ, Name str ks, mloc) sub _ r ->
-  let this = NameTree $ Map.singleton str (ks, typ, sub, mloc)
-   in l <> this <> r
+newtype Dedup k v = Dedup {unDedup :: Map k (v, Dedup k v)}
 
-structure :: [GHCDecl] -> Either ParseError (LexTree GHC.RealSrcLoc (DeclType, Name, Loc))
-structure =
-  foldM
-    (\t (ty, sp, na, mloc) -> first TreeError $ LT.insertWith f (GHC.realSrcSpanStart sp) (ty, mkName na, mloc) (GHC.realSrcSpanEnd sp) t)
-    LT.emptyLexTree
+instance (Ord k, Semigroup v) => Semigroup (Dedup k v) where
+  Dedup a <> Dedup b = Dedup (Map.unionWith (<>) a b)
+
+structure :: [RawDecl] -> Either (TreeError Loc RawDecl) (LexTree Loc RawDecl)
+structure = foldM (\ !t decl -> LT.insertWith f (rdStart decl) decl (rdEnd decl) t) LT.emptyLexTree
   where
-    f (ta, Name na ka, mloc) (tb, Name nb kb, _)
-      | ta == tb && na == nb = Just (ta, Name na (ka <> kb), mloc)
+    f (RawDecl na ka ta sa ea) (RawDecl nb kb tb _ _)
+      | ta == tb && na == nb = Just (RawDecl na (ka <> kb) ta sa ea)
       | otherwise = Nothing
 
-spanToLoc :: GHC.RealSrcSpan -> Loc
-spanToLoc spn = Loc (GHC.srcSpanStartLine spn) (GHC.srcSpanStartCol spn)
-
 -- | This is the best way I can find of checking whether the name was written by a programmer or not.
 -- GHC internally classifies names extensively, but none of those mechanisms seem to allow to distinguish GHC-generated names.
 isGenerated :: GHC.Name -> Bool
 isGenerated = elem '$' . GHC.getOccString
 
-collect :: GHC.HieFile -> Either ParseError Collect
-collect (GHC.HieFile _ _ typeArr (GHC.HieASTs asts) _ _) = execStateT (forT_ traverse asts collect') (Collect mempty mempty mempty)
+data Collect = Collect
+  { _decls :: [RawDecl],
+    _uses :: [(Loc, GHCKey)],
+    _types :: EnumMap GHCKey (EnumSet GHCKey)
+  }
+
+-- | Collect declarations, uses, and types in a HIE file
+collect :: GHC.HieFile -> Collect
+collect (GHC.HieFile _ _ typeArr (GHC.HieASTs asts) _ _) = execState (forT_ traverse asts go) (Collect mempty mempty mempty)
   where
-    tellDecl :: GHCDecl -> StateT Collect (Either ParseError) ()
-    tellDecl decl = modify $ \(Collect decls uses types) -> Collect (decl : decls) uses types
+    tellDecl :: GHC.Name -> DeclType -> GHC.RealSrcSpan -> State Collect ()
+    tellDecl nm typ spn = modify $ \(Collect decls uses types) -> Collect (decl : decls) uses types
+      where
+        decl =
+          RawDecl
+            (GHC.getOccString nm)
+            (EnumSet.singleton . ghcNameKey $ nm)
+            typ
+            (Loc (GHC.srcSpanStartLine spn) (GHC.srcSpanStartCol spn))
+            (Loc (GHC.srcSpanEndLine spn) (GHC.srcSpanEndCol spn))
 
-    tellUse :: GHC.RealSrcLoc -> GHCKey -> StateT Collect (Either ParseError) ()
-    tellUse loc key = modify $ \(Collect decls uses types) -> Collect decls ((loc, key) : uses) types
+    tellUse :: GHC.RealSrcLoc -> GHCKey -> State Collect ()
+    tellUse loc key = modify $ \(Collect decls uses types) -> Collect decls ((Loc (GHC.srcLocLine loc) (GHC.srcLocCol loc), key) : uses) types
 
-    tellType :: GHC.Name -> GHC.TypeIndex -> StateT Collect (Either ParseError) ()
+    tellType :: GHC.Name -> GHC.TypeIndex -> State Collect ()
     tellType name ix = modify $ \(Collect decls uses types) -> Collect decls uses (EnumMap.insertWith (<>) (ghcNameKey name) (typeMap EnumMap.! ix) types)
 
     typeMap = resolveTypes typeArr
 
-    collect' :: GHC.HieAST GHC.TypeIndex -> StateT Collect (Either ParseError) ()
-    collect' node@(GHC.Node _ _ children) =
+    ignoreNode nodeInfo = any ($ nodeInfo) [isInstanceNode, isTypeSignatureNode, isInlineNode, isMinimalNode, isDerivingNode]
+
+    go :: GHC.HieAST GHC.TypeIndex -> State Collect ()
+    go node@(GHC.Node _ _ children) =
       forT_ sourceInfo node $ \nodeInfo ->
-        if any ($ nodeInfo) [isInstanceNode, isTypeSignatureNode, isInlineNode, isMinimalNode, isDerivingNode]
-          then pure ()
-          else do
-            forM_ (M.toList $ GHC.nodeIdentifiers nodeInfo) $ \case
-              (Right name, GHC.IdentifierDetails ty info)
-                | not (isGenerated name) -> do
-                    mapM_ (tellType name) ty
-                    case classifyIdentifier info of
-                      IdnIgnore -> pure ()
-                      IdnUse -> tellUse (GHC.realSrcSpanStart $ GHC.nodeSpan node) (ghcNameKey name)
-                      IdnDecl typ sp
-                        | GHC.isPointSpan sp -> pure ()
-                        | otherwise -> tellDecl (typ, sp, name, spanToLoc sp)
-              _ -> pure ()
-            mapM_ collect' children
+        unless (ignoreNode nodeInfo) $ do
+          forM_ (M.toList $ GHC.nodeIdentifiers nodeInfo) $ \case
+            (Right name, GHC.IdentifierDetails ty info) | not (isGenerated name) -> do
+              mapM_ (tellType name) ty
+              case classifyIdentifier info of
+                IdnIgnore -> pure ()
+                IdnUse -> tellUse (GHC.realSrcSpanStart $ GHC.nodeSpan node) (ghcNameKey name)
+                IdnDecl typ sp
+                  | GHC.isPointSpan sp -> pure ()
+                  | otherwise -> tellDecl name typ sp
+            _ -> pure ()
+          mapM_ go children
 
+-- TODO This can be faster by storing intermediate restuls, but that has proven tricky to get right.
+resolveTypes :: Array GHC.TypeIndex GHC.HieTypeFlat -> EnumMap GHC.TypeIndex (EnumSet GHCKey)
+resolveTypes typeArray = EnumMap.fromList [(ix, evalState (go ix) mempty) | ix <- Array.indices typeArray]
+  where
+    keys :: GHC.HieType a -> EnumSet GHCKey
+    keys (GHC.HTyConApp (GHC.IfaceTyCon name _) _) = EnumSet.singleton (ghcNameKey name)
+    keys (GHC.HForAllTy ((name, _), _) _) = EnumSet.singleton (ghcNameKey name)
+    -- These are variables, which we ignore, but it can't hurt
+    keys (GHC.HTyVarTy name) = EnumSet.singleton (ghcNameKey name)
+    keys _ = mempty
+    go :: GHC.TypeIndex -> State (EnumSet GHC.TypeIndex) (EnumSet GHCKey)
+    go current =
+      gets (EnumSet.member current) >>= \case
+        True -> pure mempty
+        False -> do
+          modify (EnumSet.insert current)
+          let ty = typeArray Array.! current
+          mappend (keys ty) . mconcat <$> mapM go (Foldable.toList ty)
+
 data IdentifierType
-  = IdnDecl DeclType GHC.Span
+  = IdnDecl !DeclType !GHC.Span
   | IdnUse
   | IdnIgnore
 
@@ -248,7 +270,7 @@
   IdnIgnore <> a = a
   IdnUse <> IdnIgnore = IdnUse
   IdnUse <> a = a
-  IdnDecl typ sp <> IdnDecl typ' sp' = IdnDecl (max typ typ') (spanSpans sp sp')
+  IdnDecl typ sp <> IdnDecl typ' sp' = IdnDecl (max typ typ') (mergeSpans sp sp')
   IdnDecl typ sp <> _ = IdnDecl typ sp
 
 instance Monoid IdentifierType where mempty = IdnIgnore
diff --git a/src/Calligraphy/Phases/Render.hs b/src/Calligraphy/Phases/Render.hs
--- a/src/Calligraphy/Phases/Render.hs
+++ b/src/Calligraphy/Phases/Render.hs
@@ -2,7 +2,7 @@
 {-# LANGUAGE RecordWildCards #-}
 
 -- | Rendering takes a callgraph, and produces a dot file
-module Calligraphy.Phases.Render (render, pRenderConfig, RenderConfig) where
+module Calligraphy.Phases.Render (render, pRenderConfig, RenderConfig (..)) where
 
 import Calligraphy.Util.Printer
 import Calligraphy.Util.Types
diff --git a/src/Calligraphy/Util/LexTree.hs b/src/Calligraphy/Util/LexTree.hs
--- a/src/Calligraphy/Util/LexTree.hs
+++ b/src/Calligraphy/Util/LexTree.hs
@@ -23,6 +23,7 @@
     insert,
     emptyLexTree,
     foldLexTree,
+    toForest,
     insertWith,
     height,
     toList,
@@ -32,6 +33,7 @@
 where
 
 import Control.Applicative
+import Data.Tree (Forest, Tree (..))
 
 data LexTree p a
   = Tip
@@ -85,6 +87,11 @@
 
 emptyLexTree :: LexTree p a
 emptyLexTree = Tip
+
+toForest :: LexTree p a -> Forest (p, a, p)
+toForest lt = foldLexTree id f lt []
+  where
+    f ls l a m r rs = ls . (Node (l, a, r) (m []) :) . rs
 
 {-# INLINE height #-}
 height :: LexTree p a -> Int
diff --git a/src/Calligraphy/Util/Printer.hs b/src/Calligraphy/Util/Printer.hs
--- a/src/Calligraphy/Util/Printer.hs
+++ b/src/Calligraphy/Util/Printer.hs
@@ -46,5 +46,10 @@
 strLn :: MonadPrint m => String -> m ()
 strLn = line . TB.fromString
 
+{-# INLINE textLn #-}
 textLn :: MonadPrint m => Text -> m ()
 textLn = line . TB.fromText
+
+{-# INLINE showLn #-}
+showLn :: (MonadPrint m, Show a) => a -> m ()
+showLn = strLn . show
diff --git a/src/Calligraphy/Util/Types.hs b/src/Calligraphy/Util/Types.hs
--- a/src/Calligraphy/Util/Types.hs
+++ b/src/Calligraphy/Util/Types.hs
@@ -20,6 +20,7 @@
     forT_,
     modForest,
     modDecls,
+    forestT,
   )
 where
 
@@ -76,20 +77,25 @@
     (Eq, Ord, Show)
 
 data Loc = Loc
-  { locLine :: Int,
-    locCol :: Int
+  { locLine :: !Int,
+    locCol :: !Int
   }
+  deriving (Eq, Ord)
 
+instance Show Loc where
+  showsPrec _ (Loc ln col) = shows ln . showChar ':' . shows col
+
 {-# INLINE modDecls #-}
 modDecls :: Traversal' Module Decl
-modDecls = modForest . traverse . traverse
+modDecls = modForest . forestT
 
 {-# INLINE modForest #-}
 modForest :: Traversal' Module (Forest Decl)
 modForest f (Module nm fp ds) = Module nm fp <$> f ds
 
-instance Show Loc where
-  showsPrec _ (Loc ln col) = shows ln . showChar ':' . shows col
+{-# INLINE forestT #-}
+forestT :: Traversal (Forest a) (Forest b) a b
+forestT = traverse . traverse
 
 rekeyCalls :: (Enum a, Ord b) => EnumMap a b -> Set (a, a) -> Set (b, b)
 rekeyCalls m = foldr (maybe id Set.insert . bitraverse (flip EnumMap.lookup m) (flip EnumMap.lookup m)) mempty