diff --git a/CHANGELOG.md b/CHANGELOG.md
new file mode 100644
--- /dev/null
+++ b/CHANGELOG.md
@@ -0,0 +1,6 @@
+# Changelog
+
+## 0.1.0
+
+### [Added]
+- Initial release
diff --git a/LICENSE b/LICENSE
new file mode 100644
--- /dev/null
+++ b/LICENSE
@@ -0,0 +1,29 @@
+BSD 3-Clause License
+
+Copyright (c) 2021, Jonas Carpay
+All rights reserved.
+
+Redistribution and use in source and binary forms, with or without
+modification, are permitted provided that the following conditions are met:
+
+1. Redistributions of source code must retain the above copyright notice, this
+   list of conditions and the following disclaimer.
+
+2. 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.
+
+3. Neither the name of the copyright holder nor the names of its
+   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 HOLDER 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/README.md b/README.md
new file mode 100644
--- /dev/null
+++ b/README.md
@@ -0,0 +1,58 @@
+# calligraphy
+[![calligraphy on Hackage](https://img.shields.io/hackage/v/calligraphy)](http://hackage.haskell.org/package/calligraphy)
+[![calligraphy on Stackage Nightly](https://stackage.org/package/calligraphy/badge/nightly)](https://stackage.org/nightly/package/calligraphy)
+
+![Calligraphy](./calligraphy.svg)
+
+`calligraphy` is a Haskell call graph/source code visualizer.
+
+It works directly on GHC-generated HIE files, giving us features that would otherwise be tricky, like type information and support for generated files.
+`calligraphy` has been tested with all versions of GHC that can produce HIE files (i.e. GHC 8.8, 8.10, 9.0, and 9.2.)
+
+See [the accompanying blog post](https://jonascarpay.com/posts/2022-04-01-salt.html) for more examples, and an extended tutorial.
+
+## Usage
+
+1. Install `calligraphy` through your Haskell package manager.
+Since it uses HIE files, it usually needs to be compiled with the same version of GHC as your project.
+
+2. Install [GraphViz](https://graphviz.org/). By default, `calligraphy` needs `dot` to be available in the search path.
+
+3. Generate HIE files for your project by passing the `-fwrite-ide-info` to GHC.
+If you're using Cabal, for example, you'd invoke `cabal new-build --ghc-options=-fwrite-ide-info`
+
+4. Run `calligraphy`.
+You probably want to start by running `calligraphy --help` to see what options it supports, but as an example, the above graph was produced using the following command:
+```
+calligraphy Calligraphy --output-png out.png --collapse-data
+```
+Where `Calligraphy` in this case is the name of the module.
+
+## Philosophy
+
+Writing and especially maintaining Haskell tooling is really hard.
+Haskell, let alone GHC, is underspecified, overcomplicated, and constantly changing.
+If you don't have a strategy for dealing with this, reality eventually catches up with you; there is an abundance of abandoned projects (think formatters, linters, editor plugins, IDEs, etc.)
+So too it is with `calligraphy`.
+Working with HIE files instead of Haskell source files allows us to leverage GHC for parsing and type checking, which is nice, but HIE files themselves are nothing but untyped views into GHC's eldritch heart, and come with their own threats to sanity.
+So, how _do_ we deal with this?
+
+Put simply, the goal of `calligraphy` is not to be accurate, but to be as simple as possible while still being useful.
+If we can get 80% accuracy for 20% of the effort, that's great, and if we can get 64% accuracy for 4% effort, that's even better.
+That necessarily means that **`calligraphy` will sometimes be wrong.**
+When this happens, please open a bug report (especially if it's egregious), but know that there's a chance it's simply not worth fixing.
+
+Here's an example.
+The type-related logic is currently ~15 lines.
+It works by, for every identifier, walking the type HIE gives us for that identifier, and adding an edge to every identifier it references.
+This works perfectly in 95% of cases, but field accessors will, _only on GHC 9.2_ and _only sometimes_, not get the type of their parent data type.
+That's annoying, but we have to draw a line somewhere, and `calligraphy` always errs towards simplicity and maintainability.
+We _could_ try to figure out and fix this as a special case, or try to use information from type signatures to fix it in general, but for this project the 15 lines is more important than the 95%.
+As another example, supporting for graphing Template Haskell-generated code would be a great feature, and it seems like it'd be easy to implement since HIE files are generated _after_ TH expansion.
+Unfortunately however, the way TH code appears in the HIE output breaks many heuristics that we currently use to structure the source graph, so for now I decided that unless there's an elegant way to naturally incorporate it, it's not worth it.
+
+That doesn't mean that we don't care about accuracy at all.
+The test suite contains a baseline reference module, and makes sure that `calligraphy` generates the same correct graph for it across GHC versions.
+Finding a simple, maintainable, and robust set of heuristics that passes the test suite and never face plants on edge cases, took months, a lot of failed attempts, and a hefty dose of sunk cost fallacy.
+Furthermore, there's almost certainly still ways to make it simpler and more general.
+I'm very open to questions and suggestions on how to do this, especially if you have experience with GHC/HIE files.
diff --git a/app/Main.hs b/app/Main.hs
new file mode 100644
--- /dev/null
+++ b/app/Main.hs
@@ -0,0 +1,4 @@
+import qualified Calligraphy
+
+main :: IO ()
+main = Calligraphy.main
diff --git a/calligraphy.cabal b/calligraphy.cabal
new file mode 100644
--- /dev/null
+++ b/calligraphy.cabal
@@ -0,0 +1,93 @@
+cabal-version:   2.4
+name:            calligraphy
+version:         0.1.0
+license:         BSD-3-Clause
+build-type:      Simple
+license-file:    LICENSE
+author:          Jonas Carpay
+maintainer:      Jonas Carpay <jonascarpay@gmail.com>
+copyright:       2022 Jonas Carpay
+tested-with:     GHC ==8.8.4 || ==8.10.7 || ==9.0.2 || ==9.2.2
+extra-doc-files:
+  CHANGELOG.md
+  README.md
+
+synopsis:        HIE-based Haskell call graph and source code visualizer
+description:
+  Calligraphy is a Haskell call graph/source code visualizer.
+  It works directly on GHC-generated HIE files, giving us features that would otherwise be tricky, like type information and support for generated files.
+  Calligraphy has been tested with all versions of GHC that can produce HIE files (i.e. GHC 8.8, 8.10, 9.0, and 9.2.)
+  See the project's github page for more information.
+
+homepage:        https://github.com/jonascarpay/calligraphy#readme
+category:        Development, Haskell, Language
+
+source-repository head
+  type:     git
+  location: git://github.com/jonascarpay/calligraphy
+
+common common-options
+  build-depends:    base >=4.9 && <5
+  default-language: Haskell2010
+  ghc-options:
+    -Wall -Wcompat -Widentities -Wincomplete-uni-patterns
+    -Wincomplete-record-updates -Wredundant-constraints
+    -fhide-source-paths -Wpartial-fields
+
+library
+  import:          common-options
+  hs-source-dirs:  src
+  other-modules:   Paths_calligraphy
+  autogen-modules: Paths_calligraphy
+  exposed-modules:
+    Calligraphy
+    Calligraphy.Compat.Debug
+    Calligraphy.Compat.GHC
+    Calligraphy.Compat.Lib
+    Calligraphy.Phases.Collapse
+    Calligraphy.Phases.DependencyFilter
+    Calligraphy.Phases.EdgeCleanup
+    Calligraphy.Phases.Parse
+    Calligraphy.Phases.Render
+    Calligraphy.Phases.Search
+    Calligraphy.Util.Lens
+    Calligraphy.Util.LexTree
+    Calligraphy.Util.Optparse
+    Calligraphy.Util.Printer
+    Calligraphy.Util.Types
+
+  build-depends:
+    , array
+    , containers
+    , directory
+    , enummapset
+    , filepath
+    , ghc
+    , mtl
+    , optparse-applicative
+    , process
+    , text
+
+executable calligraphy
+  import:         common-options
+  hs-source-dirs: app
+  main-is:        Main.hs
+  build-depends:  calligraphy
+  ghc-options:    -threaded -rtsopts -with-rtsopts=-N
+
+test-suite calligraphy-test
+  import:         common-options
+  hs-source-dirs: test
+  main-is:        Spec.hs
+  other-modules:
+    Test.LexTree
+    Test.Reference
+
+  build-depends:
+    , calligraphy
+    , containers
+    , hspec
+    , HUnit
+    , QuickCheck
+
+  type:           exitcode-stdio-1.0
diff --git a/src/Calligraphy.hs b/src/Calligraphy.hs
new file mode 100644
--- /dev/null
+++ b/src/Calligraphy.hs
@@ -0,0 +1,138 @@
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE RecordWildCards #-}
+
+module Calligraphy (main, mainWithConfig) where
+
+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.Parse
+import Calligraphy.Phases.Render
+import Calligraphy.Phases.Search
+import Calligraphy.Util.Printer
+import Calligraphy.Util.Types (ppCallGraph)
+import Control.Monad.RWS
+import Data.Text (Text)
+import qualified Data.Text as T
+import qualified Data.Text.IO as Text
+import Data.Version (showVersion)
+import Options.Applicative
+import Paths_calligraphy (version)
+import System.Directory (findExecutable)
+import System.Exit
+import System.IO (stderr)
+import System.Process
+
+main :: IO ()
+main = do
+  config <- execParser $ info (pConfig <**> helper <**> versionP) mempty
+  mainWithConfig config
+  where
+    versionP =
+      infoOption
+        ( "calligraphy version "
+            <> showVersion version
+            <> "\nhie version "
+            <> show GHC.hieVersion
+        )
+        (long "version" <> help "Show version")
+
+mainWithConfig :: AppConfig -> IO ()
+mainWithConfig AppConfig {..} = do
+  let debug :: (DebugConfig -> Bool) -> Printer () -> IO ()
+      debug fp printer = when (fp debugConfig) (printStderr printer)
+
+  hieFiles <- searchFiles searchConfig
+  when (null hieFiles) $ die "No files matched your search criteria.."
+  debug dumpHieFile $ mapM_ ppHieFile hieFiles
+
+  (parsePhaseDebug, cgParsed) <- either (printDie . ppParseError) pure (parseHieFiles hieFiles)
+  debug dumpLexicalTree $ ppParsePhaseDebugInfo parsePhaseDebug
+  let cgCollapsed = collapse collapseConfig cgParsed
+  cgDependencyFiltered <- either (printDie . ppFilterError) pure $ dependencyFilter dependencyFilterConfig cgCollapsed
+  let cgCleaned = cleanupEdges edgeFilterConfig cgDependencyFiltered
+  debug dumpFinal $ ppCallGraph cgCleaned
+
+  let txt = runPrinter $ render renderConfig cgCleaned
+
+  output outputConfig txt
+
+data AppConfig = AppConfig
+  { searchConfig :: SearchConfig,
+    collapseConfig :: CollapseConfig,
+    dependencyFilterConfig :: DependencyFilterConfig,
+    edgeFilterConfig :: EdgeCleanupConfig,
+    renderConfig :: RenderConfig,
+    outputConfig :: OutputConfig,
+    debugConfig :: DebugConfig
+  }
+
+printStderr :: Printer () -> IO ()
+printStderr = Text.hPutStrLn stderr . runPrinter
+
+printDie :: Printer () -> IO a
+printDie txt = printStderr txt >> exitFailure
+
+pConfig :: Parser AppConfig
+pConfig =
+  AppConfig <$> pSearchConfig
+    <*> pCollapseConfig
+    <*> pDependencyFilterConfig
+    <*> pEdgeCleanupConfig
+    <*> pRenderConfig
+    <*> pOutputConfig
+    <*> pDebugConfig
+
+output :: OutputConfig -> Text -> IO ()
+output cfg@OutputConfig {..} txt = do
+  unless (hasOutput cfg) $ Text.hPutStrLn stderr "Warning: no output options specified, run with --help to see options"
+  forM_ outputDotPath $ \fp -> Text.writeFile fp txt
+  forM_ outputPngPath $ \fp -> runDot ["-Tpng", "-o", fp]
+  forM_ outputSvgPath $ \fp -> runDot ["-Tsvg", "-o", fp]
+  when outputStdout $ Text.putStrLn txt
+  where
+    hasOutput (OutputConfig Nothing Nothing Nothing _ False) = False
+    hasOutput _ = True
+
+    runDot flags = do
+      mexe <- findExecutable outputEngine
+      case mexe of
+        Nothing -> die $ "Unable to find '" <> outputEngine <> "' executable! Make sure it is installed, or use another output method/engine."
+        Just exe -> do
+          (code, out, err) <- readProcessWithExitCode exe flags (T.unpack txt)
+          unless (code == ExitSuccess) $ do
+            putStrLn $ outputEngine <> " crashed:"
+            putStrLn out
+            putStrLn err
+
+data OutputConfig = OutputConfig
+  { outputDotPath :: Maybe FilePath,
+    outputPngPath :: Maybe FilePath,
+    outputSvgPath :: Maybe FilePath,
+    outputEngine :: String,
+    outputStdout :: Bool
+  }
+
+pOutputConfig :: Parser OutputConfig
+pOutputConfig =
+  OutputConfig
+    <$> optional (strOption (long "output-dot" <> short 'd' <> metavar "FILE" <> help ".dot output path"))
+    <*> optional (strOption (long "output-png" <> short 'p' <> metavar "FILE" <> help ".png output path (requires `dot` or other engine in PATH)"))
+    <*> optional (strOption (long "output-svg" <> short 's' <> metavar "FILE" <> help ".svg output path (requires `dot` or other engine in PATH)"))
+    <*> strOption (long "render-engine" <> metavar "CMD" <> help "Render engine to use with --output-png and --output-svg" <> value "dot" <> showDefault)
+    <*> switch (long "output-stdout" <> help "Output to stdout")
+
+data DebugConfig = DebugConfig
+  { dumpHieFile :: Bool,
+    dumpLexicalTree :: Bool,
+    dumpFinal :: Bool
+  }
+
+pDebugConfig :: Parser DebugConfig
+pDebugConfig =
+  DebugConfig
+    <$> switch (long "ddump-hie-file" <> help "Debug dump raw HIE files.")
+    <*> switch (long "ddump-lexical-tree" <> help "Debug dump the reconstructed lexical structure of HIE files, the intermediate output in the parsing phase.")
+    <*> switch (long "ddump-final" <> help "Debug dump the final tree after processing, i.e. as it will be rendered.")
diff --git a/src/Calligraphy/Compat/Debug.hs b/src/Calligraphy/Compat/Debug.hs
new file mode 100644
--- /dev/null
+++ b/src/Calligraphy/Compat/Debug.hs
@@ -0,0 +1,111 @@
+{-# LANGUAGE CPP #-}
+
+-- | Debug tools for GHC-related data
+module Calligraphy.Compat.Debug
+  ( ppHieFile,
+    ppIdentifier,
+    showGHCName,
+  )
+where
+
+import Calligraphy.Util.Printer
+import Control.Monad
+import qualified Data.Map as Map
+
+#if MIN_VERSION_ghc(9,2,0)
+import qualified GHC.Data.FastString as GHC
+import qualified GHC.Iface.Ext.Types as GHC
+import qualified GHC.Types.Name as GHC
+import qualified GHC.Types.SrcLoc as GHC
+import qualified GHC.Types.Unique as GHC
+import qualified GHC.Unit as GHC
+import qualified GHC.Utils.Outputable as GHC
+import GHC.Iface.Ext.Types
+#elif MIN_VERSION_ghc(9,0,0)
+import qualified GHC.Data.FastString as GHC
+import qualified GHC.Iface.Ext.Types as GHC
+import qualified GHC.Types.Name as GHC
+import qualified GHC.Types.SrcLoc as GHC
+import qualified GHC.Types.Unique as GHC
+import qualified GHC.Unit as GHC
+import qualified GHC.Utils.Outputable as GHC
+import qualified GHC.Driver.Session as GHC
+#else
+import qualified HieTypes as GHC
+import qualified Module as GHC
+import qualified FastString as GHC
+import qualified GhcPlugins as GHC
+import qualified Unique as GHC
+#endif
+
+ppHieFile :: Prints GHC.HieFile
+ppHieFile (GHC.HieFile path (GHC.Module _ mdl) _types (GHC.HieASTs asts) _exps _src) = do
+  strLn "Hie File"
+  indent $ do
+    strLn "path:"
+    indent $ strLn path
+    strLn "module: "
+    indent $ strLn (GHC.moduleNameString mdl)
+    strLn "contents:"
+    indent $
+#if MIN_VERSION_ghc(9,2,0)
+      forM_ (Map.toList asts) $ \(GHC.LexicalFastString hiePath, ast) -> do
+#else
+      forM_ (Map.toList asts) $ \(hiePath, ast) -> do
+#endif
+        strLn (GHC.unpackFS hiePath)
+        indent $ ppAst ast
+
+ppAst :: GHC.HieAST a -> Printer ()
+#if MIN_VERSION_ghc(9,2,0)
+ppAst (GHC.Node (GHC.SourcedNodeInfo nodeInfo) spn children) = do
+  strLn (showSpan spn)
+  forM_ (Map.toList nodeInfo) $ \(origin, GHC.NodeInfo anns _ ids) -> do
+    case origin of
+      GeneratedInfo -> strLn "GeneratedInfo"
+      SourceInfo -> strLn "SourceInfo"
+    indent $  do
+      forM_ (Map.toList ids) $ \(idn, GHC.IdentifierDetails _ idnDetails) -> do
+        ppIdentifier idn
+        indent $ forM_ idnDetails $ strLn . GHC.showSDocOneLine GHC.defaultSDocContext . GHC.ppr
+      forM_ anns $ \(GHC.NodeAnnotation constr typ) -> strLn (show (constr, typ))
+  indent $ mapM_ ppAst children
+#elif MIN_VERSION_ghc(9,0,0)
+ppAst (GHC.Node (GHC.SourcedNodeInfo nodeInfo) spn children) = do
+  strLn (showSpan spn)
+  forM_ nodeInfo $ \ (GHC.NodeInfo anns _ ids) -> do
+    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
+  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 $ mapM_ ppAst children
+#endif
+
+showSpan :: GHC.RealSrcSpan -> String
+showSpan s =
+  mconcat
+    [ show $ GHC.srcSpanStartLine s,
+      ":",
+      show $ GHC.srcSpanStartCol s,
+      " - ",
+      show $ GHC.srcSpanEndLine s,
+      ":",
+      show $ GHC.srcSpanEndCol s
+    ]
+
+ppIdentifier :: Prints GHC.Identifier
+ppIdentifier = strLn . either showModuleName showGHCName
+
+showModuleName :: GHC.ModuleName -> String
+showModuleName = flip mappend " (module)" . show . GHC.moduleNameString
+
+showGHCName :: GHC.Name -> String
+showGHCName name = GHC.getOccString name <> "    " <> show (GHC.getKey $ GHC.nameUnique name)
diff --git a/src/Calligraphy/Compat/GHC.hs b/src/Calligraphy/Compat/GHC.hs
new file mode 100644
--- /dev/null
+++ b/src/Calligraphy/Compat/GHC.hs
@@ -0,0 +1,68 @@
+{-# LANGUAGE CPP #-}
+
+-- | Thin compatability layer that re-exports things from GHC.
+module Calligraphy.Compat.GHC
+  ( BindType (..),
+    ContextInfo (..),
+    DeclType (..),
+    HieAST (..),
+    HieASTs (..),
+    HieFile (..),
+    HieFileResult (..),
+    HieType (..),
+    HieTypeFlat,
+    Identifier,
+    IdentifierDetails (..),
+    IfaceTyCon (..),
+    ModuleName,
+    Name,
+    NameCache,
+    NodeInfo (..),
+    RealSrcLoc,
+    RealSrcSpan,
+    RecFieldContext (..),
+    Scope (..),
+    Span,
+    TypeIndex,
+    availNames,
+    getKey,
+    getOccString,
+    hieVersion,
+    initNameCache,
+    mkSplitUniqSupply,
+    moduleName,
+    moduleNameString,
+    nameUnique,
+    realSrcSpanEnd,
+    realSrcSpanStart,
+    srcSpanStartCol,
+    srcSpanStartLine,
+    srcSpanEndCol,
+    srcSpanEndLine,
+  )
+where
+
+#if MIN_VERSION_ghc(9,0,0)
+import GHC.Iface.Ext.Binary
+import GHC.Iface.Ext.Types
+import GHC.Iface.Type
+import GHC.Types.Avail
+import GHC.Types.Name
+import GHC.Types.Name.Cache
+import GHC.Types.SrcLoc
+import GHC.Types.Unique
+import GHC.Types.Unique.Supply
+import GHC.Unit.Module.Name
+import GHC.Unit.Types
+#else
+import Avail
+import GHC
+import HieBin
+import HieTypes
+import IfaceType
+import Name
+import NameCache
+import SrcLoc
+import UniqSupply
+import Unique
+#endif
diff --git a/src/Calligraphy/Compat/Lib.hs b/src/Calligraphy/Compat/Lib.hs
new file mode 100644
--- /dev/null
+++ b/src/Calligraphy/Compat/Lib.hs
@@ -0,0 +1,111 @@
+{-# LANGUAGE CPP #-}
+{-# LANGUAGE OverloadedStrings #-}
+{-# OPTIONS_GHC -Wno-redundant-constraints -Wno-unused-matches #-}
+
+module Calligraphy.Compat.Lib
+  ( sourceInfo,
+    showContextInfo,
+    readHieFileCompat,
+    isInstanceNode,
+    isTypeSignatureNode,
+    isInlineNode,
+    isMinimalNode,
+    isDerivingNode,
+    showAnns,
+    spanSpans,
+  )
+where
+
+import Calligraphy.Util.Lens
+import Data.IORef
+import qualified Data.Set as Set
+
+#if MIN_VERSION_ghc(9,0,0)
+import GHC.Iface.Ext.Binary
+import GHC.Iface.Ext.Types
+import GHC.Types.Name.Cache
+import GHC.Types.SrcLoc
+import GHC.Utils.Outputable (ppr, showSDocUnsafe)
+import qualified Data.Map as Map
+#else
+import HieBin
+import HieTypes
+import NameCache
+import SrcLoc
+#endif
+
+{-# INLINE sourceInfo #-}
+sourceInfo :: Traversal' (HieAST a) (NodeInfo a)
+showContextInfo :: ContextInfo -> String
+readHieFileCompat :: IORef NameCache -> FilePath -> IO HieFileResult
+#if MIN_VERSION_ghc(9,0,0)
+
+sourceInfo f (Node (SourcedNodeInfo inf) sp children) = (\inf' -> Node (SourcedNodeInfo inf') sp children) <$> Map.alterF (maybe (pure Nothing) (fmap Just . f)) SourceInfo inf
+
+showContextInfo = showSDocUnsafe . ppr
+
+readHieFileCompat ref = readHieFile (NCU (atomicModifyIORef ref))
+
+#else
+
+sourceInfo f (Node inf sp children) = (\inf' -> Node inf' sp children) <$> f inf
+
+showContextInfo = show
+
+readHieFileCompat ref fp = do
+  cache <- readIORef ref
+  (res, cache') <- readHieFile cache fp
+  writeIORef ref cache'
+  pure res
+
+#endif
+
+isInstanceNode :: NodeInfo a -> Bool
+isTypeSignatureNode :: NodeInfo a -> Bool
+isInlineNode :: NodeInfo a -> Bool
+isMinimalNode :: NodeInfo a -> Bool
+isDerivingNode :: NodeInfo a -> Bool
+showAnns :: NodeInfo a -> String
+#if MIN_VERSION_ghc(9,2,0)
+
+isInstanceNode (NodeInfo anns _ _) = any (flip Set.member anns) [NodeAnnotation "ClsInstD" "InstDecl", NodeAnnotation "DerivDecl" "DerivDecl"]
+
+isTypeSignatureNode (NodeInfo anns _ _) = Set.member (NodeAnnotation "TypeSig" "Sig") anns
+
+isInlineNode (NodeInfo anns _ _) = Set.member (NodeAnnotation "InlineSig" "Sig") anns
+
+isMinimalNode (NodeInfo anns _ _) = Set.member (NodeAnnotation "MinimalSig" "Sig") anns
+
+isDerivingNode (NodeInfo anns _ _) = Set.member (NodeAnnotation "HsDerivingClause" "HsDerivingClause") anns
+
+showAnns (NodeInfo anns _ _) = unwords (show . unNodeAnnotation <$> Set.toList anns)
+  where
+    unNodeAnnotation (NodeAnnotation a b) = (a, b)
+
+#else
+
+isInstanceNode (NodeInfo anns _ _) = any (flip Set.member anns) [("ClsInstD", "InstDecl"), ("DerivDecl", "DerivDecl")]
+
+isTypeSignatureNode (NodeInfo anns _ _) = Set.member ("TypeSig", "Sig") anns
+
+isInlineNode (NodeInfo anns _ _) = Set.member ("InlineSig", "Sig") anns
+
+isMinimalNode (NodeInfo anns _ _) = Set.member ("MinimalSig", "Sig") anns
+
+isDerivingNode (NodeInfo anns _ _) = Set.member ("HsDerivingClause", "HsDerivingClause") anns
+
+showAnns (NodeInfo anns _ _) = unwords (show <$> Set.toList anns)
+
+#endif
+
+spanSpans :: Span -> Span -> Span
+spanSpans sp1 sp2 =
+  mkRealSrcSpan
+    ( min
+        (realSrcSpanStart sp1)
+        (realSrcSpanStart sp2)
+    )
+    ( max
+        (realSrcSpanEnd sp1)
+        (realSrcSpanEnd sp2)
+    )
diff --git a/src/Calligraphy/Phases/Collapse.hs b/src/Calligraphy/Phases/Collapse.hs
new file mode 100644
--- /dev/null
+++ b/src/Calligraphy/Phases/Collapse.hs
@@ -0,0 +1,86 @@
+{-# 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
new file mode 100644
--- /dev/null
+++ b/src/Calligraphy/Phases/DependencyFilter.hs
@@ -0,0 +1,155 @@
+{-# LANGUAGE ScopedTypeVariables #-}
+{-# OPTIONS_GHC -Wno-name-shadowing #-}
+
+-- | Dependency filtering is removing all nodes that are not part of a certain dependency tree
+module Calligraphy.Phases.DependencyFilter
+  ( DependencyFilterConfig,
+    DependencyFilterError (..),
+    ppFilterError,
+    dependencyFilter,
+    pDependencyFilterConfig,
+  )
+where
+
+import Calligraphy.Util.Optparse (boolFlags)
+import Calligraphy.Util.Printer
+import Calligraphy.Util.Types
+import Control.Monad.State.Strict
+import Data.Bifunctor (bimap)
+import Data.EnumMap (EnumMap)
+import qualified Data.EnumMap as EnumMap
+import Data.EnumSet (EnumSet)
+import qualified Data.EnumSet as EnumSet
+import Data.Foldable (toList)
+import Data.List.NonEmpty (NonEmpty, nonEmpty)
+import Data.Map (Map)
+import qualified Data.Map as Map
+import Data.Monoid
+import Data.Set (Set)
+import qualified Data.Set as Set
+import Data.Tree
+import Data.Tuple (swap)
+import Options.Applicative
+import Prelude hiding (filter)
+
+data DependencyFilterConfig = DependencyFilterConfig
+  { _depRoot :: Maybe (NonEmpty String),
+    _revDepRoot :: Maybe (NonEmpty String),
+    _depDepth :: Maybe Int,
+    _followParent :: Bool,
+    _followChildren :: Bool,
+    _followCalls :: Bool,
+    _followTypes :: Bool
+  }
+
+pDependencyFilterConfig :: Parser DependencyFilterConfig
+pDependencyFilterConfig =
+  DependencyFilterConfig
+    <$> (fmap nonEmpty . many)
+      ( strOption
+          ( long "forward-root"
+              <> short 'f'
+              <> metavar "NAME"
+              <> help "Name of a dependency filter root. Specifying a dependency filter root hides everything that's not a (transitive) dependency of a root. The name can be qualified. This argument can be repeated."
+          )
+      )
+    <*> (fmap nonEmpty . many)
+      ( strOption
+          ( long "reverse-root"
+              <> short 'r'
+              <> metavar "NAME"
+              <> help "Name of a reverse dependency filter root. Specifying a dependency filter root hides everything that's not a reverse (transitive) dependency of a root. The name can be qualified. This argument can be repeated."
+          )
+      )
+    <*> optional (option auto (long "max-depth" <> help "Maximum search depth for transitive dependencies."))
+    <*> boolFlags True "follow-parent" "In calculating (transitive) dependencies, follow edges to from a child to its parent." mempty
+    <*> boolFlags True "follow-child" "In calculating (transitive) dependencies, follow edges from a parent to its children." mempty
+    <*> boolFlags True "follow-value" "In calculating (transitive) dependencies, follow normal edges." mempty
+    <*> boolFlags False "follow-type" "In calculating (transitive) dependencies, follow type edges." mempty
+
+newtype DependencyFilterError = UnknownRootName String
+
+ppFilterError :: Prints DependencyFilterError
+ppFilterError (UnknownRootName root) = strLn $ "Unknown root name: " <> root
+
+pruneModules :: (Decl -> Bool) -> CallGraph -> CallGraph
+pruneModules p (CallGraph modules calls types) = removeDeadCalls $ CallGraph modules' calls types
+  where
+    modules' = over (traverse . modForest) (>>= go) modules
+    go :: Tree Decl -> [Tree Decl]
+    go (Node decl children) = do
+      let children' = children >>= go
+       in if p decl then pure (Node decl children') else children'
+
+-- | Remove all calls and typings (i.e. edges) where one end is not present in the graph.
+-- This is intended to be used after an operation that may have removed nodes from the graph.
+removeDeadCalls :: CallGraph -> CallGraph
+removeDeadCalls (CallGraph mods calls types) = CallGraph mods calls' types'
+  where
+    outputKeys = execState (forT_ (traverse . modDecls) mods (modify . EnumSet.insert . declKey)) mempty
+    calls' = Set.filter (\(a, b) -> EnumSet.member a outputKeys && EnumSet.member b outputKeys) calls
+    types' = Set.filter (\(a, b) -> EnumSet.member a outputKeys && EnumSet.member b outputKeys) types
+
+dependencyFilter :: DependencyFilterConfig -> CallGraph -> Either DependencyFilterError CallGraph
+dependencyFilter (DependencyFilterConfig mfw mbw maxDepth useParent useChild useCalls useTypes) mods@(CallGraph modules calls types) = do
+  fwFilter <- forM mfw $ flip mkDepFilter edges
+  bwFilter <- forM mbw $ flip mkDepFilter (Set.map swap edges)
+  pure $
+    let p = case (fwFilter, bwFilter) of
+          (Nothing, Nothing) -> const True
+          (Just fa, Nothing) -> fa
+          (Nothing, Just fb) -> fb
+          (Just fa, Just fb) -> \decl -> fa decl || fb decl
+     in pruneModules p mods
+  where
+    names :: Map String (EnumSet Key)
+    names = Map.unionsWith mappend (fmap resolveNames modules)
+    mkDepFilter :: NonEmpty String -> Set (Key, Key) -> Either DependencyFilterError (Decl -> Bool)
+    mkDepFilter rootNames edges = do
+      rootKeys <- forM rootNames $ \name -> maybe (Left $ UnknownRootName name) (pure . EnumSet.toList) (Map.lookup name names)
+      let ins = transitives maxDepth (mconcat $ toList rootKeys) edges
+      pure $ \decl -> EnumSet.member (declKey decl) ins
+
+    edges =
+      mconcat
+        [ if useParent then parentEdges else mempty,
+          if useChild then childEdges else mempty,
+          if useCalls then calls else mempty,
+          if useTypes then types else mempty
+        ]
+
+    parentEdges, childEdges :: Set (Key, Key)
+    (parentEdges, childEdges) = execState (forT_ (traverse . modForest . traverse) modules go) mempty
+      where
+        go :: Tree Decl -> State (Set (Key, Key), Set (Key, Key)) ()
+        go (Node parent children) =
+          forM_ children $ \childNode@(Node child _) -> do
+            let kParent = declKey parent
+                kChild = declKey child
+            modify $ bimap (Set.insert (kParent, kChild)) (Set.insert (kChild, kParent))
+            go childNode
+
+-- | Create a map of all names, and the keys they correspond to.
+-- For every name in the source, this introduces two entries; one naked, and one qualified with the module name.
+resolveNames :: Module -> Map String (EnumSet Key)
+resolveNames (Module modName _ forest) =
+  flip execState mempty $
+    flip (traverse . traverse) forest $
+      \(Decl name key _ _ _ _) ->
+        modify $
+          Map.insertWith (<>) (modName <> "." <> name) (EnumSet.singleton key)
+            . Map.insertWith (<>) name (EnumSet.singleton key)
+
+transitives :: forall a. Enum a => Maybe Int -> [a] -> Set (a, a) -> EnumSet a
+transitives maxDepth roots deps = go 0 mempty (EnumSet.fromList roots)
+  where
+    go :: Int -> EnumSet a -> EnumSet a -> EnumSet a
+    go depth old new
+      | EnumSet.null new = old
+      | maybe False (< depth) maxDepth = old
+      | otherwise =
+          let old' = old <> new
+              new' = EnumSet.foldr (\a -> maybe id mappend $ EnumMap.lookup a adjacencies) mempty new
+           in go (depth + 1) old' (new' EnumSet.\\ old')
+    adjacencies :: EnumMap a (EnumSet a)
+    adjacencies = foldr (\(from, to) -> EnumMap.insertWith (<>) from (EnumSet.singleton to)) mempty deps
diff --git a/src/Calligraphy/Phases/EdgeCleanup.hs b/src/Calligraphy/Phases/EdgeCleanup.hs
new file mode 100644
--- /dev/null
+++ b/src/Calligraphy/Phases/EdgeCleanup.hs
@@ -0,0 +1,47 @@
+{-# LANGUAGE NamedFieldPuns #-}
+
+-- | This modules collects some opinionated common-sense heuristics for removing edges that are probably redundant.
+module Calligraphy.Phases.EdgeCleanup (EdgeCleanupConfig, cleanupEdges, pEdgeCleanupConfig) where
+
+import Calligraphy.Util.Types
+import Control.Monad.State.Strict
+import Data.Set (Set)
+import qualified Data.Set as Set
+import Data.Tree
+import Options.Applicative
+
+data EdgeCleanupConfig = EdgeCleanupConfig
+  { cleanDoubles :: Bool,
+    cleanLoops :: Bool,
+    cleanData :: Bool,
+    cleanClass :: Bool
+  }
+
+cleanupEdges :: EdgeCleanupConfig -> CallGraph -> CallGraph
+cleanupEdges
+  EdgeCleanupConfig {cleanDoubles, cleanLoops, cleanData, cleanClass}
+  (CallGraph mods calls types) =
+    CallGraph mods (cleanLoopsFn calls) (cleanLoopsFn . cleanDoublesFn . cleanDataFn . cleanClassFn $ types)
+    where
+      cleanLoopsFn = if cleanLoops then Set.filter (uncurry (/=)) else id
+      cleanDoublesFn = if cleanDoubles then (Set.\\ calls) else id
+      cleanDataFn = if cleanData then (Set.\\ dataEdges) else id
+      cleanClassFn = if cleanClass then (Set.\\ classEdges) else id
+      dataEdges = execState (forT_ (traverse . modForest . traverse) mods go) mempty
+        where
+          go :: Tree Decl -> State (Set (Key, Key)) ()
+          go (Node (Decl _ k _ _ DataDecl _) children) = void $ (traverse . traverse) (\d -> modify (Set.insert (declKey d, k))) children
+          go (Node _ children) = mapM_ go children
+      classEdges = execState (forT_ (traverse . modForest . traverse) mods go) mempty
+        where
+          go :: Tree Decl -> State (Set (Key, Key)) ()
+          go (Node (Decl _ k _ _ ClassDecl _) children) = void $ (traverse . traverse) (\d -> modify (Set.insert (declKey d, k))) children
+          go (Node _ children) = mapM_ go children
+
+pEdgeCleanupConfig :: Parser EdgeCleanupConfig
+pEdgeCleanupConfig =
+  EdgeCleanupConfig
+    <$> flag True False (long "no-clean-double-edges" <> help "Don't remove type edges when value edges already exist.")
+    <*> flag True False (long "no-clean-loops" <> help "Don't remove edges that start and stop at the same node, i.e. simple recursion.")
+    <*> flag True False (long "no-clean-data" <> help "Don't remove type edges constructors/records back to the parent data type. These are removed by default because their behavior is unreliable, and they're generally redundant.")
+    <*> flag True False (long "no-clean-classes" <> help "Don't remove type edges from class members back to the parent class. These are removed by default because their behavior is unreliable, and they're generally redundant.")
diff --git a/src/Calligraphy/Phases/Parse.hs b/src/Calligraphy/Phases/Parse.hs
new file mode 100644
--- /dev/null
+++ b/src/Calligraphy/Phases/Parse.hs
@@ -0,0 +1,271 @@
+{-# LANGUAGE DerivingStrategies #-}
+{-# LANGUAGE LambdaCase #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+
+module Calligraphy.Phases.Parse
+  ( parseHieFiles,
+    ppParseError,
+    ppParsePhaseDebugInfo,
+    ParseError (..),
+    ParsePhaseDebugInfo (..),
+  )
+where
+
+import qualified Calligraphy.Compat.GHC as GHC
+import Calligraphy.Compat.Lib (isDerivingNode, isInlineNode, isInstanceNode, isMinimalNode, isTypeSignatureNode, sourceInfo, spanSpans)
+import Calligraphy.Util.LexTree (LexTree, TreeError (..), foldLexTree)
+import qualified Calligraphy.Util.LexTree as LT
+import Calligraphy.Util.Printer
+import Calligraphy.Util.Types
+import Control.Monad.Except
+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)
+import qualified Data.EnumSet as EnumSet
+import qualified Data.Foldable as Foldable
+import Data.List (unzip4)
+import Data.Map (Map)
+import qualified Data.Map as M
+import qualified Data.Map as Map
+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)
+
+data Collect = Collect
+  { _decls :: [GHCDecl],
+    _uses :: [(GHC.RealSrcLoc, GHCKey)],
+    _types :: EnumMap GHCKey (EnumSet GHCKey)
+  }
+
+newtype ParseError = TreeError (TreeError GHC.RealSrcLoc (DeclType, Name, Loc))
+
+ppParseError :: Prints ParseError
+ppParseError (TreeError err) = 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 MidSplit = strLn "MidSplit"
+    ppTreeError (LexicalError l (ty, nm, _) r t) = do
+      strLn "Lexical error"
+      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
+
+ppLexTree :: Prints (LexTree GHC.RealSrcLoc (DeclType, Name, Loc))
+ppLexTree = foldLexTree (pure ()) $ \ls l (typ, name, _loc) m r rs -> do
+  ls
+  ppLocNode l r typ name
+  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))]
+  }
+
+ppParsePhaseDebugInfo :: Prints ParsePhaseDebugInfo
+ppParsePhaseDebugInfo (ParsePhaseDebugInfo mods) = forM_ mods $ \(modName, ltree) -> do
+  strLn modName
+  indent $ ppLexTree ltree
+
+data ParsedFile = ParsedFile
+  { _pfModuleName :: String,
+    _pfFilePath :: FilePath,
+    _pfDecls :: Forest Decl,
+    _pfCalls :: Set (GHCKey, GHCKey),
+    _pfTypings :: EnumMap GHCKey (EnumSet GHCKey),
+    _pfDebugTree :: LexTree GHC.RealSrcLoc (DeclType, Name, Loc)
+  }
+
+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)
+  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
+
+rekey :: forall m. Monad m => EnumSet GHCKey -> NameTree -> StateT (Int, EnumMap GHCKey Key) m (Forest Decl)
+rekey exports = go
+  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
+      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'
+
+newtype NameTree = NameTree (Map String (EnumSet GHCKey, DeclType, NameTree, Loc))
+
+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)
+
+instance Monoid NameTree where mempty = NameTree mempty
+
+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
+
+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
+  where
+    f (ta, Name na ka, mloc) (tb, Name nb kb, _)
+      | ta == tb && na == nb = Just (ta, Name na (ka <> kb), mloc)
+      | 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)
+  where
+    tellDecl :: GHCDecl -> StateT Collect (Either ParseError) ()
+    tellDecl decl = modify $ \(Collect decls uses types) -> Collect (decl : decls) uses types
+
+    tellUse :: GHC.RealSrcLoc -> GHCKey -> StateT Collect (Either ParseError) ()
+    tellUse loc key = modify $ \(Collect decls uses types) -> Collect decls ((loc, key) : uses) types
+
+    tellType :: GHC.Name -> GHC.TypeIndex -> StateT Collect (Either ParseError) ()
+    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) =
+      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 -> tellDecl (typ, sp, name, spanToLoc sp)
+              _ -> pure ()
+            mapM_ collect' children
+
+data IdentifierType
+  = IdnDecl DeclType GHC.Span
+  | IdnUse
+  | IdnIgnore
+
+instance Semigroup IdentifierType where
+  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
+
+instance Monoid IdentifierType where mempty = IdnIgnore
+
+classifyIdentifier :: Set GHC.ContextInfo -> IdentifierType
+classifyIdentifier = foldMap classify
+  where
+    classify :: GHC.ContextInfo -> IdentifierType
+    classify (GHC.Decl GHC.DataDec (Just sp)) = IdnDecl DataDecl sp
+    classify (GHC.Decl GHC.PatSynDec (Just sp)) = IdnDecl DataDecl sp
+    classify (GHC.Decl GHC.FamDec (Just sp)) = IdnDecl DataDecl sp
+    classify (GHC.Decl GHC.SynDec (Just sp)) = IdnDecl DataDecl sp
+    classify (GHC.Decl GHC.ConDec (Just sp)) = IdnDecl ConDecl sp
+    classify (GHC.Decl GHC.ClassDec (Just sp)) = IdnDecl ClassDecl sp
+    classify (GHC.ClassTyDecl (Just sp)) = IdnDecl ValueDecl sp
+    classify (GHC.ValBind GHC.RegularBind _ (Just sp)) = IdnDecl ValueDecl sp
+    classify (GHC.RecField GHC.RecFieldDecl (Just sp)) = IdnDecl RecDecl sp
+    -- Use
+    classify (GHC.RecField GHC.RecFieldAssign _) = IdnUse
+    classify (GHC.RecField GHC.RecFieldOcc _) = IdnUse
+    classify GHC.Use = IdnUse
+    -- Ignore
+    classify _ = IdnIgnore
diff --git a/src/Calligraphy/Phases/Render.hs b/src/Calligraphy/Phases/Render.hs
new file mode 100644
--- /dev/null
+++ b/src/Calligraphy/Phases/Render.hs
@@ -0,0 +1,149 @@
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE RecordWildCards #-}
+
+-- | Rendering takes a callgraph, and produces a dot file
+module Calligraphy.Phases.Render (render, pRenderConfig, RenderConfig) where
+
+import Calligraphy.Util.Printer
+import Calligraphy.Util.Types
+import Control.Monad
+import qualified Data.EnumSet as EnumSet
+import Data.List (intercalate)
+import Data.Tree (Tree (..))
+import Options.Applicative hiding (style)
+import Text.Show (showListWith)
+
+data RenderConfig = RenderConfig
+  { showCalls :: Bool,
+    showTypes :: Bool,
+    showKey :: Bool,
+    showGHCKeys :: Bool,
+    showModulePath :: Bool,
+    showChildArrowhead :: Bool,
+    locMode :: LocMode,
+    clusterModules :: Bool,
+    clusterGroups :: Bool,
+    splines :: Bool,
+    reverseDependencyRank :: Bool
+  }
+
+render :: RenderConfig -> Prints CallGraph
+render RenderConfig {..} (CallGraph modules calls types) = do
+  brack "digraph calligraphy {" "}" $ do
+    unless splines $ textLn "splines=false;"
+    textLn "node [style=filled fillcolor=\"#ffffffcf\"];"
+    textLn "graph [outputorder=edgesfirst];"
+    let nonEmptyModules = filter (not . null . moduleForest) modules
+    forM_ (zip nonEmptyModules [0 :: Int ..]) $
+      \(Module modName modPath forest, moduleIx) ->
+        moduleCluster moduleIx (if showModulePath then modPath else modName) $
+          forM_ (zip forest [0 :: Int ..]) $ \(root, forestIx) -> do
+            treeCluster moduleIx forestIx $
+              renderTreeNode root
+    when showCalls $
+      forM_ calls $ \(caller, callee) ->
+        if reverseDependencyRank
+          then edge caller callee []
+          else edge callee caller ["dir" .= "back"]
+    when showTypes $
+      forM_ types $ \(caller, callee) ->
+        if reverseDependencyRank
+          then edge caller callee ["style" .= "dotted"]
+          else edge callee caller ["style" .= "dotted", "dir" .= "back"]
+  where
+    moduleCluster :: Int -> String -> Printer a -> Printer a
+    moduleCluster modIx title inner
+      | clusterModules =
+          brack ("subgraph cluster_module_" <> show modIx <> " {") "}" $ do
+            strLn $ "label=" <> show title <> ";"
+            inner
+      | otherwise = inner
+    treeCluster :: Int -> Int -> Printer a -> Printer a
+    treeCluster modIx groupIx inner
+      | clusterGroups =
+          brack ("subgraph cluster_" <> show modIx <> "_" <> show groupIx <> " {") "}" $ do
+            textLn "style=invis;"
+            inner
+      | otherwise = inner
+    nodeLabel :: Decl -> String
+    nodeLabel (Decl name key ghcKeys _ _ loc) =
+      intercalate "\n"
+        . cons name
+        . consIf showKey (show (unKey key))
+        . consManyIf showGHCKeys (fmap (show . unGHCKey) (EnumSet.toList ghcKeys))
+        . ( case locMode of
+              Hide -> id
+              Line -> cons ('L' : show (locLine loc))
+              LineCol -> cons (show loc)
+          )
+        $ []
+
+    renderTreeNode :: Prints (Tree Decl)
+    renderTreeNode (Node decl@(Decl _ key _ exported typ _) children) = do
+      strLn $ show (unKey key) <> " " <> style ["label" .= show (nodeLabel decl), "shape" .= nodeShape typ, "style" .= nodeStyle]
+      forM_ children $ \child@(Node childDecl _) -> do
+        renderTreeNode child
+        edge key (declKey childDecl)
+          . cons ("style" .= "dashed")
+          . consIf (not showChildArrowhead) ("arrowhead" .= "none")
+          $ []
+      where
+        nodeStyle :: String
+        nodeStyle =
+          show . intercalate ", "
+            . consIf (typ == RecDecl) "rounded"
+            . consIf (not exported) "dashed"
+            . cons "filled"
+            $ []
+
+cons :: a -> [a] -> [a]
+cons = (:)
+
+consIf :: Bool -> a -> [a] -> [a]
+consIf True = (:)
+consIf False = flip const
+
+consManyIf :: Foldable f => Bool -> f a -> [a] -> [a]
+consManyIf True fs as = foldr (:) as fs
+consManyIf False _ as = as
+
+nodeShape :: DeclType -> String
+nodeShape DataDecl = "octagon"
+nodeShape ConDecl = "box"
+nodeShape RecDecl = "box"
+nodeShape ClassDecl = "house"
+nodeShape ValueDecl = "ellipse"
+
+edge :: MonadPrint m => Key -> Key -> Style -> m ()
+edge (Key from) (Key to) sty = strLn $ show from <> " -> " <> show to <> " " <> style sty
+
+(.=) :: String -> String -> (String, String)
+(.=) = (,)
+
+style :: Style -> String
+style sty = showListWith (\(key, val) -> showString key . showChar '=' . showString val) sty ";"
+
+type Style = [(String, String)]
+
+data LocMode = Hide | Line | LineCol
+
+pLocMode :: Parser LocMode
+pLocMode =
+  flag' Line (long "show-line" <> help "Show line numbers")
+    <|> flag' LineCol (long "show-line-col" <> help "Show line and column numbers")
+    <|> pure Hide
+
+pRenderConfig :: Parser RenderConfig
+pRenderConfig =
+  RenderConfig
+    <$> flag True False (long "hide-calls" <> help "Don't show call arrows")
+    <*> flag True False (long "hide-types" <> help "Don't show type arrows")
+    <*> flag False True (long "show-key" <> help "Show internal keys with identifiers. Useful for debugging.")
+    <*> flag False True (long "show-ghc-key" <> help "Show GHC keys with identifiers. Useful for debugging.")
+    <*> flag False True (long "show-module-path" <> help "Show a module's filepath instead of its name")
+    <*> flag False True (long "show-child-arrowhead" <> help "Put an arrowhead at the end of a parent-child edge")
+    <*> pLocMode
+    <*> flag True False (long "no-cluster-modules" <> help "Don't draw modules as a cluster.")
+    <*> flag True False (long "no-cluster-trees" <> help "Don't draw definition trees as a cluster.")
+    <*> flag True False (long "no-splines" <> help "Render arrows as straight lines instead of splines")
+    <*> flag False True (long "reverse-dependency-rank" <> help "Make dependencies have lower rank than the dependee, i.e. show dependencies above their parent.")
diff --git a/src/Calligraphy/Phases/Search.hs b/src/Calligraphy/Phases/Search.hs
new file mode 100644
--- /dev/null
+++ b/src/Calligraphy/Phases/Search.hs
@@ -0,0 +1,109 @@
+{-# LANGUAGE NamedFieldPuns #-}
+
+module Calligraphy.Phases.Search
+  ( searchFiles,
+    pSearchConfig,
+    SearchConfig,
+  )
+where
+
+import qualified Calligraphy.Compat.GHC as GHC
+import Calligraphy.Compat.Lib (readHieFileCompat)
+import Control.Applicative
+import Control.Monad.State
+import Data.IORef
+import Data.List (isPrefixOf)
+import Data.List.NonEmpty (NonEmpty (..), nonEmpty, toList)
+import Options.Applicative hiding (str)
+import System.Directory (doesDirectoryExist, doesFileExist, listDirectory, makeAbsolute)
+import System.FilePath (isExtensionOf, (</>))
+
+searchFiles :: SearchConfig -> IO [GHC.HieFile]
+searchFiles SearchConfig {searchDotPaths, searchRoots, includePatterns, excludePatterns} = do
+  hieFilePaths <- searchHieFilePaths
+
+  hieFiles <- do
+    uniqSupply <- GHC.mkSplitUniqSupply 'z'
+    ref <- newIORef (GHC.initNameCache uniqSupply [])
+    forM hieFilePaths (readHieFileWithWarning ref)
+
+  pure $
+    flip filter hieFiles $ \file ->
+      let matches pat =
+            matchPattern pat (GHC.moduleNameString . GHC.moduleName . GHC.hie_module $ file)
+              || matchPattern pat (GHC.hie_hs_file file)
+       in maybe True (any matches) includePatterns && maybe True (not . any matches) excludePatterns
+  where
+    searchHieFilePaths = do
+      roots <- mapM makeAbsolute (maybe ["./."] toList searchRoots)
+      foldMap go roots
+      where
+        go :: FilePath -> IO [FilePath]
+        go path = do
+          isFile <- doesFileExist path
+          if isFile && isExtensionOf ".hie" path
+            then pure [path]
+            else do
+              isDir <- doesDirectoryExist path
+              if isDir
+                then do
+                  contents <- (if searchDotPaths then id else filter (not . isPrefixOf ".")) <$> listDirectory path
+                  foldMap (go . (path </>)) contents
+                else pure []
+
+readHieFileWithWarning :: IORef GHC.NameCache -> FilePath -> IO GHC.HieFile
+readHieFileWithWarning ref path = do
+  GHC.HieFileResult fileHieVersion fileGHCVersion hie <- readHieFileCompat ref path
+  when (GHC.hieVersion /= fileHieVersion) $ do
+    putStrLn $ "WARNING: version mismatch in " <> path
+    putStrLn $ "    The hie files in this project were generated with GHC version: " <> show fileGHCVersion
+    putStrLn $ "    This version of calligraphy was compiled with GHC version: " <> show GHC.hieVersion
+    putStrLn $ "    Optimistically continuing anyway..."
+  pure hie
+
+data SearchConfig = SearchConfig
+  { includePatterns :: Maybe (NonEmpty Pattern),
+    excludePatterns :: Maybe (NonEmpty Pattern),
+    searchDotPaths :: Bool,
+    searchRoots :: Maybe (NonEmpty FilePath)
+  }
+
+newtype Pattern = Pattern String
+
+matchPattern :: Pattern -> String -> Bool
+matchPattern (Pattern matcher) = go False matcher
+  where
+    go _ ('*' : ms) cs = go True ms cs
+    go False (m : ms) (c : cs) = m == c && go False ms cs
+    go True ms (c : cs) = go True ms cs || go False ms (c : cs)
+    go _ [] [] = True
+    go _ _ _ = False
+
+pSearchConfig :: Parser SearchConfig
+pSearchConfig =
+  SearchConfig
+    <$> (fmap nonEmpty . many)
+      ( Pattern
+          <$> strArgument
+            ( metavar "MODULE"
+                <> help "Name or filepath of a module to include in the call graph. Can contain '*' wildcards. Defaults to '*'."
+            )
+      )
+    <*> (fmap nonEmpty . many)
+      ( Pattern
+          <$> strOption
+            ( long "exclude"
+                <> short 'e'
+                <> metavar "MODULE"
+                <> help "Name or filepath of a module to exclude in the call graph. Can contain '*' wildcards."
+            )
+      )
+    <*> switch (long "hidden" <> help "Search paths with a leading period. Disabled by default.")
+    <*> (fmap nonEmpty . many)
+      ( strOption
+          ( long "input"
+              <> short 'i'
+              <> metavar "PATH"
+              <> help "Filepaths to search for HIE files. If passed a file, it will be processed as is. If passed a directory, the directory will be searched recursively. Can be repeated. Defaults to './.'"
+          )
+      )
diff --git a/src/Calligraphy/Util/Lens.hs b/src/Calligraphy/Util/Lens.hs
new file mode 100644
--- /dev/null
+++ b/src/Calligraphy/Util/Lens.hs
@@ -0,0 +1,37 @@
+{-# LANGUAGE DeriveFunctor #-}
+{-# LANGUAGE RankNTypes #-}
+
+module Calligraphy.Util.Lens
+  ( Traversal,
+    Traversal',
+    over,
+    forT_,
+  )
+where
+
+import Data.Functor.Identity
+
+type Traversal s t a b = forall m. Applicative m => (a -> m b) -> (s -> m t)
+
+type Traversal' s a = Traversal s s a a
+
+newtype ConstT m a = ConstT {unConstT :: m ()}
+  deriving (Functor)
+
+instance Applicative m => Applicative (ConstT m) where
+  {-# INLINE pure #-}
+  pure _ = ConstT (pure ())
+  {-# INLINE (<*>) #-}
+  ConstT mf <*> ConstT ma = ConstT (mf *> ma)
+
+{-# INLINE over #-}
+over :: Traversal s t a b -> (a -> b) -> (s -> t)
+over t f = runIdentity . t (Identity . f)
+
+{-# INLINE mapT_ #-}
+mapT_ :: Applicative m => Traversal s t a b -> (a -> m ()) -> s -> m ()
+mapT_ t f = unConstT . t (ConstT . f)
+
+{-# INLINE forT_ #-}
+forT_ :: Applicative m => Traversal s t a b -> s -> (a -> m ()) -> m ()
+forT_ t = flip (mapT_ t)
diff --git a/src/Calligraphy/Util/LexTree.hs b/src/Calligraphy/Util/LexTree.hs
new file mode 100644
--- /dev/null
+++ b/src/Calligraphy/Util/LexTree.hs
@@ -0,0 +1,164 @@
+{-# LANGUAGE DeriveTraversable #-}
+
+-- | A 'LexTree' is a map designed to reconstruct the lexical structure (tree of scopes) of a source file, given an unordered list of scopes.
+-- Values are inserted with a pair source locations as its key.
+-- For a given key, we can then ask what the smallest enclosing scope is.
+--
+-- For example, in the snippet below the smallest scope containing @x@ is @b@.
+-- @
+--      x
+-- |      a      |
+--    |  b  |
+--                   |   c   |
+-- @
+--
+-- Scopes are not allowed to overlap.
+--
+-- The purpose of this data structure is to find out what surrounding definition a certain use site belongs to.
+module Calligraphy.Util.LexTree
+  ( LexTree (..),
+    TreeError (..),
+    Calligraphy.Util.LexTree.lookup,
+    lookupOuter,
+    insert,
+    emptyLexTree,
+    foldLexTree,
+    insertWith,
+    height,
+    toList,
+    bin,
+    shift,
+  )
+where
+
+import Control.Applicative
+
+data LexTree p a
+  = Tip
+  | Bin
+      {-# UNPACK #-} !Int
+      -- ^ Height
+      !(LexTree p a)
+      -- ^ Scopes at the same level, left of this one
+      !p
+      -- ^ Left-hand bound of this scope (inclusive)
+      a
+      !(LexTree p a)
+      -- ^ Children
+      !p
+      -- ^ Right-hand bound of this scope (exclusive)
+      !(LexTree p a)
+      -- ^ Scopes at the same level, right of this entry
+  deriving (Show, Functor, Foldable, Traversable)
+
+instance (Eq p, Eq a) => Eq (LexTree p a) where
+  ta == tb = toList ta == toList tb
+
+lookup :: Ord p => p -> LexTree p a -> Maybe a
+lookup p = foldLexTree Nothing f
+  where
+    f ls l a m r rs
+      | p >= l && p < r = m <|> Just a
+      | p < l = ls
+      | p >= r = rs
+      | otherwise = error "impossible"
+
+lookupOuter :: Ord p => p -> LexTree p a -> Maybe a
+lookupOuter p = foldLexTree Nothing f
+  where
+    f ls l a _ r rs
+      | p >= l && p < r = Just a
+      | p < l = ls
+      | p >= r = rs
+      | otherwise = error "impossible"
+
+toList :: LexTree p a -> [(p, a, p)]
+toList t = foldLexTree id f t []
+  where
+    f ls l a m r rs = ls . ((l, a, r) :) . m . rs
+
+foldLexTree :: r -> (r -> p -> a -> r -> p -> r -> r) -> LexTree p a -> r
+foldLexTree fTip fBin = go
+  where
+    go Tip = fTip
+    go (Bin _ ls l a ms r rs) = fBin (go ls) l a (go ms) r (go rs)
+
+emptyLexTree :: LexTree p a
+emptyLexTree = Tip
+
+{-# INLINE height #-}
+height :: LexTree p a -> Int
+height Tip = 0
+height (Bin h _ _ _ _ _ _) = h
+
+shift :: Num p => p -> LexTree p a -> LexTree p a
+shift p = go
+  where
+    go Tip = Tip
+    go (Bin h ls l a ms r rs) = Bin h (go ls) (l + p) a (go ms) (r + p) (go rs)
+
+data TreeError p a
+  = -- | Nonsensical bounds, i.e. a left-hand bound larger than the right-hand obund
+    InvalidBounds p a p
+  | -- | Two identical scopes
+    OverlappingBounds a a p p
+  | -- | An attempt to split halfway through a scope, usually the result of two partially overlapping scopes
+    MidSplit
+  | -- | Attempting to insert a scope that would not form a tree structure
+    LexicalError p a p (LexTree p a)
+  deriving (Functor, Foldable, Traversable, Eq, Show)
+
+{-# INLINE bin' #-}
+bin' :: LexTree p a -> p -> a -> LexTree p a -> p -> LexTree p a -> LexTree p a
+bin' ls l a ms r rs = Bin (max (height ls) (height rs) + 1) ls l a ms r rs
+
+-- | Only works if the height difference of the two trees is at most 2
+{-# INLINE bin #-}
+bin :: LexTree p a -> p -> a -> LexTree p a -> p -> LexTree p a -> LexTree p a
+bin (Bin lh lls ll la lms lr lrs) l a ms r rs
+  | lh > height rs + 1 =
+      case lrs of
+        Bin lrh lrls lrl lra lrms lrr lrrs | lrh > height lls -> bin' (bin' lls ll la lms lr lrls) lrl lra lrms lrr (bin' lrrs l a ms r rs)
+        _ -> bin' lls ll la lms lr (bin' lrs l a ms r rs)
+bin ls l a ms r (Bin rh rls rl ra rms rr rrs)
+  | rh > height ls + 1 =
+      case rls of
+        Bin rlh rlls rll rla rlms rlr rlrs | rlh > height rrs -> bin' (bin' ls l a ms r rlls) rll rla rlms rlr (bin' rlrs rl ra rms rr rrs)
+        _ -> bin' (bin' ls l a ms r rls) rl ra rms rr rrs
+bin ls l a ms r rs = bin' ls l a ms r rs
+
+split :: Ord p => p -> LexTree p a -> Either (TreeError p a) (LexTree p a, LexTree p a)
+split p = go
+  where
+    go Tip = pure (Tip, Tip)
+    go (Bin _ ls l a ms r rs)
+      | p <= l = do
+          (ll, lr) <- go ls
+          pure (ll, bin lr l a ms r rs)
+      | p >= r = do
+          (rl, rr) <- go rs
+          pure (bin ls l a ms r rl, rr)
+      | otherwise = Left MidSplit
+
+{-# INLINE insertWith #-}
+insertWith :: Ord p => (a -> a -> Maybe a) -> p -> a -> p -> LexTree p a -> Either (TreeError p a) (LexTree p a)
+insertWith f il ia ir t
+  | il >= ir = Left $ InvalidBounds il ia ir
+  | otherwise = go t
+  where
+    go Tip = pure $ bin Tip il ia Tip ir Tip
+    go (Bin h ls l a ms r rs)
+      | ir <= l = flip fmap (go ls) $ \ls' -> bin ls' l a ms r rs
+      | il >= r = flip fmap (go rs) $ \rs' -> bin ls l a ms r rs'
+      | il == l && ir == r = case f ia a of
+          Just a' -> pure $ Bin h ls l a' ms r rs
+          Nothing -> Left $ OverlappingBounds ia a il ir
+      | il >= l && ir <= r = flip fmap (go ms) $ \ms' -> bin ls l a ms' r rs
+      | il <= l && ir >= r = do
+          (ll, lr) <- split il ls
+          (rl, rr) <- split ir rs
+          pure $ bin ll il ia (bin lr l a ms r rl) ir rr
+      | otherwise = Left $ LexicalError il ia ir t
+
+insert :: Ord p => p -> a -> p -> LexTree p a -> Either (TreeError p a) (LexTree p a)
+insert = insertWith (\_ _ -> Nothing)
diff --git a/src/Calligraphy/Util/Optparse.hs b/src/Calligraphy/Util/Optparse.hs
new file mode 100644
--- /dev/null
+++ b/src/Calligraphy/Util/Optparse.hs
@@ -0,0 +1,80 @@
+-- Adapted (stolen) from https://github.com/commercialhaskell/stack/blob/d8fc7a1344fdd2dd9227f419b0b06ae1e5d4ede6/src/Options/Applicative/Builder/Extra.hs
+
+module Calligraphy.Util.Optparse (boolFlags) where
+
+import Options.Applicative
+
+-- | Enable/disable flags for a 'Bool'.
+boolFlags ::
+  -- | Default value
+  Bool ->
+  -- | Flag name
+  String ->
+  -- | Help suffix
+  String ->
+  Mod FlagFields Bool ->
+  Parser Bool
+boolFlags defaultValue name helpText =
+  enableDisableFlags defaultValue True False name $
+    concat
+      [ helpText,
+        " (default: ",
+        if defaultValue then "enabled" else "disabled",
+        ")"
+      ]
+
+-- | Enable/disable flags for any type.
+enableDisableFlags ::
+  -- | Default value
+  a ->
+  -- | Enabled value
+  a ->
+  -- | Disabled value
+  a ->
+  -- | Name
+  String ->
+  -- | Help suffix
+  String ->
+  Mod FlagFields a ->
+  Parser a
+enableDisableFlags defaultValue enabledValue disabledValue name helpText mods =
+  enableDisableFlagsNoDefault enabledValue disabledValue name helpText mods
+    <|> pure defaultValue
+
+-- | Enable/disable flags for any type, without a default (to allow chaining with '<|>')
+enableDisableFlagsNoDefault ::
+  -- | Enabled value
+  a ->
+  -- | Disabled value
+  a ->
+  -- | Name
+  String ->
+  -- | Help suffix
+  String ->
+  Mod FlagFields a ->
+  Parser a
+enableDisableFlagsNoDefault enabledValue disabledValue name helpText mods =
+  last
+    <$> some
+      ( ( flag'
+            enabledValue
+            ( hidden
+                <> internal
+                <> long name
+                <> mods
+            )
+            <|> flag'
+              disabledValue
+              ( hidden
+                  <> internal
+                  <> long ("no-" ++ name)
+                  <> mods
+              )
+        )
+          <|> flag'
+            disabledValue
+            ( long ("[no-]" ++ name)
+                <> help helpText
+                <> mods
+            )
+      )
diff --git a/src/Calligraphy/Util/Printer.hs b/src/Calligraphy/Util/Printer.hs
new file mode 100644
--- /dev/null
+++ b/src/Calligraphy/Util/Printer.hs
@@ -0,0 +1,50 @@
+{-# LANGUAGE DerivingVia #-}
+{-# LANGUAGE GeneralizedNewtypeDeriving #-}
+
+module Calligraphy.Util.Printer where
+
+import Control.Monad.RWS
+import Control.Monad.State
+import Data.Foldable
+import Data.Text (Text)
+import qualified Data.Text.Lazy as TL
+import Data.Text.Lazy.Builder (Builder)
+import qualified Data.Text.Lazy.Builder as TB
+
+newtype Printer a = Printer {unPrinter :: RWS Int () Builder a}
+  deriving newtype (Functor, Applicative, Monad)
+  deriving (Semigroup, Monoid) via (Ap Printer a)
+
+type Prints a = a -> Printer ()
+
+runPrinter :: Printer () -> Text
+runPrinter (Printer p) = TL.toStrict . TB.toLazyText . fst $ execRWS p 0 mempty
+
+class Monad m => MonadPrint m where
+  line :: Builder -> m ()
+  indent :: m a -> m a
+
+instance MonadPrint Printer where
+  {-# INLINE indent #-}
+  indent (Printer p) = Printer $ local (+ 4) p
+
+  {-# INLINE line #-}
+  line t = Printer $ do
+    n <- ask
+    modify $
+      flip mappend $ fold (replicate n (TB.singleton ' ')) <> t <> TB.singleton '\n'
+
+instance MonadPrint m => MonadPrint (StateT s m) where
+  line = lift . line
+  indent (StateT m) = StateT $ indent . m
+
+{-# INLINE brack #-}
+brack :: MonadPrint m => String -> String -> m a -> m a
+brack pre post inner = strLn pre *> indent inner <* strLn post
+
+{-# INLINE strLn #-}
+strLn :: MonadPrint m => String -> m ()
+strLn = line . TB.fromString
+
+textLn :: MonadPrint m => Text -> m ()
+textLn = line . TB.fromText
diff --git a/src/Calligraphy/Util/Types.hs b/src/Calligraphy/Util/Types.hs
new file mode 100644
--- /dev/null
+++ b/src/Calligraphy/Util/Types.hs
@@ -0,0 +1,105 @@
+{-# LANGUAGE DerivingStrategies #-}
+{-# LANGUAGE GeneralizedNewtypeDeriving #-}
+
+module Calligraphy.Util.Types
+  ( -- * Data types
+    CallGraph (..),
+    Module (..),
+    Decl (..),
+    DeclType (..),
+    Key (..),
+    GHCKey (..),
+    Loc (..),
+
+    -- * Utility functions
+    rekeyCalls,
+    ppCallGraph,
+
+    -- * Lensy stuff
+    over,
+    forT_,
+    modForest,
+    modDecls,
+  )
+where
+
+import Calligraphy.Util.Lens
+import Calligraphy.Util.Printer
+import Control.Monad
+import Data.Bitraversable (bitraverse)
+import Data.EnumMap (EnumMap)
+import qualified Data.EnumMap as EnumMap
+import Data.EnumSet (EnumSet)
+import Data.Graph
+import Data.Set (Set)
+import qualified Data.Set as Set
+
+-- | This is the main type that processing phases will operate on.
+-- Note that calls and typing judgments are part of this top-level structure, not of the individual modules.
+data CallGraph = CallGraph
+  { _modules :: [Module],
+    _calls :: Set (Key, Key),
+    _types :: Set (Key, Key)
+  }
+
+data Module = Module
+  { moduleName :: String,
+    modulePath :: FilePath,
+    moduleForest :: Forest Decl
+  }
+
+data Decl = Decl
+  { declName :: String,
+    declKey :: Key,
+    declGHCKeys :: EnumSet GHCKey,
+    declExported :: Bool,
+    declType :: DeclType,
+    declLoc :: Loc
+  }
+
+-- | A key in our own local space, c.f. a key that was generated by GHC.
+newtype Key = Key {unKey :: Int}
+  deriving (Enum, Show, Eq, Ord)
+
+-- | A key that was produced by GHC, c.f. Key that we produced ourselves.
+-- We wrap it in a newtype because GHC itself uses a type synonym, but we want conversions to be as explicit as possible.
+newtype GHCKey = GHCKey {unGHCKey :: Int}
+  deriving newtype (Show, Enum, Eq, Ord)
+
+data DeclType
+  = ValueDecl
+  | RecDecl
+  | ConDecl
+  | DataDecl
+  | ClassDecl
+  deriving
+    (Eq, Ord, Show)
+
+data Loc = Loc
+  { locLine :: Int,
+    locCol :: Int
+  }
+
+{-# INLINE modDecls #-}
+modDecls :: Traversal' Module Decl
+modDecls = modForest . traverse . traverse
+
+{-# 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
+
+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
+
+ppCallGraph :: Prints CallGraph
+ppCallGraph (CallGraph modules _ _) = forM_ modules $ \(Module modName modPath forest) -> do
+  strLn $ modName <> " (" <> modPath <> ")"
+  indent $ mapM_ ppTree forest
+
+ppTree :: Prints (Tree Decl)
+ppTree (Node (Decl name _key _ghckey _exp typ loc) children) = do
+  strLn $ name <> " (" <> show typ <> ", " <> show loc <> ")"
+  indent $ mapM_ ppTree children
diff --git a/test/Spec.hs b/test/Spec.hs
new file mode 100644
--- /dev/null
+++ b/test/Spec.hs
@@ -0,0 +1,7 @@
+import Test.Hspec
+import qualified Test.LexTree as TS
+
+main :: IO ()
+main =
+  hspec $ do
+    TS.spec
diff --git a/test/Test/LexTree.hs b/test/Test/LexTree.hs
new file mode 100644
--- /dev/null
+++ b/test/Test/LexTree.hs
@@ -0,0 +1,148 @@
+{-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE TypeApplications #-}
+{-# OPTIONS_GHC -Wno-orphans #-}
+
+module Test.LexTree where
+
+import Calligraphy.Util.LexTree
+import Control.Applicative
+import Control.Monad
+import qualified Data.Foldable as Foldable
+import Data.Maybe (fromMaybe, isJust)
+import Test.Hspec
+import Test.Hspec.QuickCheck
+import Test.QuickCheck
+
+instance (Arbitrary a, Arbitrary p, Ord p, Num p) => Arbitrary (LexTree p a) where
+  arbitrary = sized goSized
+    where
+      goSized 0 = pure Tip
+      goSized n =
+        oneof
+          [ pure Tip,
+            do
+              m <- goSized (div n 2)
+              (l, r) <- suchThat (liftA2 (,) (goSized (div n 2)) (goSized (div n 2))) $ \(l, r) -> abs (height l - height r) < 3
+              a <- arbitrary
+              (padL, padR) <- suchThatMap arbitrary $ \(NonNegative padL, NonNegative padR) -> do
+                guard (padL > 0 || padL > 0)
+                pure (padL, padR)
+              NonNegative borderL <- arbitrary
+              NonNegative borderR <- arbitrary
+              let lr = maybe 0 snd (range l)
+              let (_ml, mr) = fromMaybe (0, 0) (range m)
+                  pl = lr + borderL
+                  pml = pl + padL
+                  pmr = pml + mr
+                  pr = pmr + padR + borderR
+              pure $ bin l pl a (shift pml m) (pmr + padR) (shift pr r)
+          ]
+  shrink Tip = []
+  shrink (Bin _ ls l a ms r rs) =
+    concat
+      [ [Tip, ls, ms, rs],
+        (\ms' -> bin ls l a ms' r rs) <$> shrink ms,
+        (\a' -> bin ls l a' ms r rs) <$> shrink a
+      ]
+
+spec :: Spec
+spec =
+  describe "LexTree" $ do
+    prop "arbitrary trees are valid" $ check @Int @()
+    prop "inserting increases length by 1" $ \l a r (t :: LexTree Int Int) ->
+      case insert l a r t of
+        Left _ -> discard
+        Right t' -> length t + 1 == length t'
+    describe "inserting produces valid trees" $ do
+      prop "inserting produces trees with valid bounds" $ \l a r (t :: LexTree Int Int) ->
+        case insert l a r t of
+          Left _ -> discard
+          Right t' -> checkBounds t'
+      prop "inserting produces trees with valid height" $ \l a r (t :: LexTree Int Int) ->
+        case insert l a r t of
+          Left _ -> discard
+          Right t' -> checkHeight t'
+      prop "inserting produces trees with valid balance" $ \l a r (t :: LexTree Int Int) ->
+        case insert l a r t of
+          Left _ -> discard
+          Right t' -> checkBalance t'
+    prop "after inserting, we can get the element back" $ \l a r (t :: LexTree Int Int) ->
+      case insert l a r t of
+        Left _ -> discard
+        Right t' -> elem a (lookupStack l t')
+    prop "inserting leaves other elements in the same order" $ \l p r (t :: LexTree Int Int) ->
+      let f (a : as) (b : bs) | a == b = f as bs
+          f (_ : as) bs = as == bs
+          f _ _ = False
+       in case insert l p r t of
+            Left _ -> discard
+            Right t' -> f (Foldable.toList t') (Foldable.toList t)
+    prop "listifying and back succeeds and is valid" $ \(t :: LexTree Int Int) ->
+      case foldM (\acc (l, a, r) -> insert l a r acc) Tip (toList t) of
+        Left _ -> False
+        Right t' -> check t'
+    prop "listifying and back succeeds and is the same tree" $ \(t :: LexTree Int Int) ->
+      case foldM (\acc (l, a, r) -> insert l a r acc) Tip (toList t) of
+        Left _ -> False
+        Right t' -> t == t'
+
+checkBounds :: Ord p => LexTree p a -> Bool
+checkBounds t = isJust $ foldLexTreeM (pure Nothing) f t
+  where
+    f ml bl _ msub br mr = do
+      guard (bl < br)
+      forM_ msub $ \(sl, sr) -> guard $ sl >= bl && sr <= br
+      l <- case ml of
+        Nothing -> pure bl
+        Just (ll, lr) -> do
+          guard $ lr <= bl
+          pure ll
+      r <- case mr of
+        Nothing -> pure br
+        Just (rl, rr) -> do
+          guard $ rl >= br
+          pure rr
+      pure (Just (l, r))
+
+foldLexTreeM :: Monad m => m r -> (r -> p -> a -> r -> p -> r -> m r) -> LexTree p a -> m r
+foldLexTreeM fTip fBin =
+  foldLexTree
+    fTip
+    (\ml l a mm r mr -> do l' <- ml; m' <- mm; r' <- mr; fBin l' l a m' r r')
+
+check :: Ord p => LexTree p a -> Bool
+check t = checkBounds t && checkHeight t && checkBalance t
+
+checkHeight :: LexTree p a -> Bool
+checkHeight = isJust . go
+  where
+    go Tip = pure 0
+    go (Bin h ml _ _ m _ mr) = do
+      l <- go ml
+      r <- go mr
+      _ <- go m
+      let h' = max l r + 1
+      guard (h == h')
+      pure h'
+
+checkBalance :: LexTree p a -> Bool
+checkBalance Tip = True
+checkBalance (Bin _ l _ _ m _ r) =
+  and
+    [ checkBalance l,
+      checkBalance r,
+      checkBalance m,
+      abs (height l - height r) < 2
+    ]
+
+range :: LexTree p a -> Maybe (p, p)
+range = foldLexTree Nothing $ \l pl _ _ pr r -> Just (maybe pl fst l, maybe pr snd r)
+
+lookupStack :: Ord p => p -> LexTree p a -> [a]
+lookupStack p = foldLexTree [] f
+  where
+    f ls l a m r rs
+      | p >= l && p < r = a : m
+      | p < l = ls
+      | p >= r = rs
+      | otherwise = error "impossible"
diff --git a/test/Test/Reference.hs b/test/Test/Reference.hs
new file mode 100644
--- /dev/null
+++ b/test/Test/Reference.hs
@@ -0,0 +1,106 @@
+{-# LANGUAGE DefaultSignatures #-}
+{-# LANGUAGE GADTs #-}
+{-# LANGUAGE PatternSynonyms #-}
+{-# LANGUAGE StandaloneDeriving #-}
+{-# LANGUAGE TypeFamilies #-}
+{-# OPTIONS_GHC -Wno-unused-imports -Wno-unused-top-binds -Wno-partial-fields -Wno-missing-signatures -Wno-missing-fields -Wno-unused-matches #-}
+
+module Test.Reference
+  ( ExportedT (Exported),
+    exportedFun,
+    Class (method),
+    TypeSynonym,
+  )
+where
+
+import Control.Monad hiding (when)
+import Data.Functor.Identity
+import Data.Kind (Type)
+import qualified Data.Map as M
+
+data ExportedT
+  = Exported (Identity Int)
+  | NotExported (M.Map Int Int)
+  | Single
+
+deriving instance Eq ExportedT
+
+deriving instance Ord ExportedT
+
+data Record
+  = Record1 {field1 :: Int, field2 :: Record, field3 :: Int}
+  | Record2 {field3 :: Int}
+  | NoRecord Int
+
+data LocalT
+  = Loc1 Int Int
+  | Loc2 Bool
+  deriving (Show)
+
+exportedFun :: Int -> Int
+exportedFun = a
+  where
+    a = b
+    b = a
+
+pattern Zero :: Int
+pattern Zero = 0
+
+data WithSignature (a :: Type -> Type)
+
+data GADT a where
+  GADTInt :: GADT Int
+  GADTFloat :: GADT LocalT
+
+class Class a where
+  type CTF a :: Type
+  data CDF a
+  method :: a -> LocalT
+  default method :: a -> LocalT
+  method _ = impl
+    where
+      impl = Loc2 True
+  {-# INLINE method #-}
+  hiddenMethod :: a -> a
+  {-# MINIMAL hiddenMethod #-}
+
+class Class a => SubClass a where
+  soup :: a -> Int
+
+instance Class ExportedT where
+  type CTF ExportedT = Int
+  data CDF ExportedT = FooData
+  method _ = Loc1 1 2
+  hiddenMethod = id
+
+type TypeSynonym a = Int
+
+type family TypeFamily a :: Type where
+  TypeFamily Int = Float
+
+newtype Newtype = Newtype {accessor :: Int}
+
+localFun :: Class a => a -> a
+localFun = hiddenMethod
+
+untyped = Single
+
+emptyMap :: M.Map Int Int
+emptyMap = M.empty
+
+recFn :: Record -> Record
+recFn Record1 {field1 = x} = undefined x
+recFn NoRecord {} = Record1 {field1 = 0, field2 = undefined}
+recFn x = NoRecord $ field3 x
+
+expValue :: Int -> Int
+expValue 0 = 4
+expValue x = error $ foo (Loc2 True)
+  where
+    foo :: LocalT -> String
+    foo (Loc1 a b) = "asdfasdf"
+    foo (Loc2 True) = "sdfgdfsg"
+    foo (Loc2 False) = error "soup"
+
+expArg :: a -> a
+expArg x = x