Parse the resolved physical source graph

9 files changed, 1465 insertions, 182 deletions

diff --git a/package.yaml b/package.yaml
index 1586d6a..e87220c 100644
--- a/package.yaml
+++ b/package.yaml
@@ -40,6 +40,7 @@ dependencies:
     - time
     - transformers
     - unliftio
+    - unix
     - unordered-containers
     - vector
     - shake
diff --git a/source/Api.hs b/source/Api.hs
index 57153df..804b222 100644
--- a/source/Api.hs
+++ b/source/Api.hs
@@ -38,6 +38,10 @@ module Api
 import Base
 import Checking
 import Encoding
+import Felix.Parse (ParseException(..), ParseWorkspaceError(..), ParsedSourceWorkspace)
+import Felix.Parse qualified as Felix
+import Felix.Source
+import Felix.Source.Graph (buildResolvedSourceGraph)
 import Filter(filterTask)
 import Meaning (GlossError(..), glossStep, initialGlossState)
 import Megalodon qualified
@@ -45,24 +49,20 @@ import Provers
 import Render.Html qualified as Html
 import Report.Location
 import Syntax.Abstract qualified as Raw
-import Syntax.Adapt (adaptChunks, scanChunk, ScannedLexicalItem)
-import Syntax.Concrete
+import Syntax.Adapt (scanChunk, ScannedLexicalItem)
 import Syntax.Internal qualified as Internal
-import Syntax.Lexicon (Lexicon, builtins)
+import Syntax.Lexicon (builtins)
 import Syntax.Token
 import TheoryGraph (TheoryGraph, Precedes(..))
 import TheoryGraph qualified
 import Tptp.UnsortedFirstOrder qualified as Tptp
 
 import Control.Monad.Logger
-import Data.List (intercalate)
 import Control.Monad.Reader
 import Data.Set qualified as Set
 import Data.Text.IO qualified as Text
-import qualified Data.Text as Text
 import GHC.Conc (getNumProcessors, retry)
 import System.FilePath.Posix
-import Text.Earley (parser, fullParses, Report(..))
 import Text.Megaparsec hiding (parse, Token)
 import UnliftIO
 import UnliftIO.Directory
@@ -121,16 +121,17 @@ findAndReadFile path = do
 lexFile :: MonadIO io => FilePath -> io (Text, [[Located Token]])
 lexFile file = do
     raw <- findAndReadFile file
-    fileId <- registerFilePath file
+    registration <- registerFilePath file
+    fileId <- either
+        (throwIO . DirectSourceLocationRegistrationFailed file)
+        pure
+        registration
     case runLexer fileId file raw of
         Left tokenError ->
             throwIO (TokenError (errorBundlePretty tokenError))
         Right (_imports, chunks) ->
             pure (raw, chunks)
 
-tokenizeChunks :: MonadIO io => FilePath -> io [[Located Token]]
-tokenizeChunks file = snd <$> lexFile file
-
 -- | Throws a 'ParseException' when tokenizing fails.
 tokenize :: MonadIO io => FilePath -> io TokStream
 tokenize file = do
@@ -149,105 +150,71 @@ scan input = do
 -- parsing fails.
 parse :: MonadIO io => FilePath -> io [Raw.Block]
 parse file = do
-    blocksRef <- liftIO (newIORef [])
-    parseWith file (\block -> modifyIORef' blocksRef (block :))
-    reverse <$> liftIO (readIORef blocksRef)
+    result <- liftIO (parseDefaultWorkspace file)
+    Felix.importedBeforeImporterBlocks <$> either throwWorkspaceError pure result
 
 parseWith :: MonadIO io => FilePath -> (Raw.Block -> IO ()) -> io ()
-parseWith file emitBlock =
-    withTheoryLexicon file \lexicon chunksByFile -> do
-        let parseChunk :: [Located Token] -> ([Raw.Block], Report Text [Located Token])
-            parseChunk = fullParses (parser (grammar lexicon))
-
-            parseChunks = \case
-                [] -> skip
-                toks : restChunks -> do
-                    blocks <- parseChunkResult (parseChunk toks)
-                    liftIO (traverse_ emitBlock blocks)
-                    parseChunks restChunks
-
-        traverse_ (parseChunks . snd) chunksByFile
-
-withTheoryLexicon
-    :: MonadIO io
-    => FilePath
-    -> (Lexicon -> [(FilePath, [[Located Token]])] -> io a)
-    -> io a
-withTheoryLexicon file action = do
-    -- We need to consider the entire theory graph here already
-    -- since we can use vocabulary of imported theories.
-    theoryGraph <- constructTheoryGraph file
-    case TheoryGraph.topSortSeq theoryGraph of
-        -- LATER replace with a more helpful error message, like actually showing the cycle properly
-        Left cyc -> error ("could not linearize theory graph (likely due to circular dependencies):\n" <> show cyc)
-        Right theoryChain -> do
-            -- Tokenize once and reuse the cached chunks for both lexicon adaptation
-            -- and parsing.
-            chunksByFile <- traverse tokenizeChunks theoryChain
-            let chunksByFileList = toList chunksByFile
-                theoryFiles = toList theoryChain
-                chunksWithFiles = zip theoryFiles chunksByFileList
-
-            -- Build the final lexicon strictly so parsing does not force a retained
-            -- adaptation thunk over the entire chunk cache.
-            let lexicon = foldl' (flip adaptChunks) builtins chunksByFileList
-            lexicon `seq` action lexicon chunksWithFiles
-
-parseChunkResult :: MonadIO io => ([Raw.Block], Report Text [Located Token]) -> io [Raw.Block]
-parseChunkResult result = case result of
-    (_, Report _ es (tok:toks)) -> throwIO (UnconsumedTokens es (tok :| toks))
-    ([], _) -> throwIO EmptyParse
-    (ambi@(_:_:_), _) -> case nubOrd ambi of
-        [block] ->
-            pure [trace ("technically ambiguous parse:\n" <> show block) block]
-        ambi' -> throwIO (AmbigousParse ambi')
-    ([block], _) ->
-        pure [block]
+parseWith file emitBlock = do
+    result <- liftIO
+        (parseDefaultWorkspaceWith file (\_source block -> emitBlock block))
+    void (either throwWorkspaceError pure result)
+
+parseDefaultWorkspace
+    :: FilePath
+    -> IO (Either ParseWorkspaceError ParsedSourceWorkspace)
+parseDefaultWorkspace file =
+    parseDefaultWorkspaceWith file (\_source _block -> pure ())
+
+parseDefaultWorkspaceWith
+    :: FilePath
+    -> (ResolvedSource -> Raw.Block -> IO ())
+    -> IO (Either ParseWorkspaceError ParsedSourceWorkspace)
+parseDefaultWorkspaceWith file emitBlock = do
+    mountsResult <- prepareDefaultSourceMounts
+    requestResult <- classifyRootRequest file
+    case (mountsResult, requestResult) of
+        (Left err, _) ->
+            pure (Left (SourceWorkspaceError err))
+        (_, Left err) ->
+            pure (Left (SourceWorkspaceError err))
+        (Right mounts, Right request) -> do
+            graphResult <- buildResolvedSourceGraph mounts request
+            case graphResult of
+                Left err ->
+                    pure (Left (SourceWorkspaceError err))
+                Right graph ->
+                    Felix.parseResolvedSourceGraphWith graph emitBlock
+
+prepareDefaultSourceMounts :: IO (Either SourceError SourceMounts)
+prepareDefaultSourceMounts = do
+    currentDir <- getCurrentDirectory
+    configuredLibrary <- lookupEnv "NAPROCHE_LIB"
+    let libraryDir = configuredLibrary ?? (currentDir </> "library")
+        debugDir = currentDir </> "debug"
+    prepareSourceMounts
+        [ (sourceMountId "project", currentDir)
+        , (sourceMountId "library", libraryDir)
+        , (sourceMountId "debug", debugDir)
+        ]
+
+classifyRootRequest :: FilePath -> IO (Either SourceError RootRequest)
+classifyRootRequest file
+    | isAbsolute file =
+        existingRoot file
+    | otherwise =
+        pure (searchedRoot file)
+
+throwWorkspaceError :: MonadIO io => ParseWorkspaceError -> io a
+throwWorkspaceError = \case
+    SourceWorkspaceError err ->
+        throwIO err
+    SourceParseError _source err ->
+        throwIO err
 
 
 simpleStream :: TokStream -> [[Token]]
 simpleStream TokStream{unTokStream=chunks} = [unLocated <$> ch | ch <- chunks]
 
-
-data ParseException
-    = UnconsumedTokens [Text] (NonEmpty (Located Token)) -- ^ Expectations and unconsumed tokens.
-    | AmbigousParse [Raw.Block]
-    | EmptyParse
-    | TokenError String
-
-instance Show ParseException where
-    show = \case
-        UnconsumedTokens es (ltok :| ltoks) ->
-            let tok = unLocated ltok
-                toks = unLocated <$> ltoks
-            in
-                "unconsumed " <> describeToken tok <> " at " <> prettyLocation (startPos ltok) <> "\n" <>
-                "  " <> unwords (tokToString <$> (tok : take 4 toks)) <> "\n" <>
-                "  " <> replicate (length (tokToString tok)) '^' <> "\n" <>
-                case es of
-                    [] -> "while expecting nothing"
-                    _ -> "while expecting one of the following:\n" <> intercalate ", " (Text.unpack <$> nubOrd es)
-        AmbigousParse blocks ->
-            "ambiguous parse: " <> show blocks
-        EmptyParse ->
-            "empty parse"
-        TokenError err ->
-            err -- Re-use pretty printing from Megaparsec.
-
-instance Exception ParseException where
-
-
-describeToken :: Token -> String
-describeToken = \case
-    Word _ -> "word"
-    Variable _ -> "variable"
-    Symbol _ -> "symbol"
-    Integer _ -> "integer"
-    Command _ -> "command"
-    BeginEnv _ -> "begin of environment"
-    EndEnv _ -> "end of environment"
-    _ -> "delimiter"
-
 -- | gloss generates internal represantation of the LaTeX files.
 -- First the file will be parsed and therefore checkt for grammer.
 -- 'meaning' then transfer the raw parsed grammer to the internal semantics.
@@ -472,21 +439,13 @@ exportHtml file = do
     pure (Html.renderDocument file hints rootBlocks theoryBlocks)
 
 parseHtmlBlocks :: MonadIO io => FilePath -> io ([Raw.Block], [Raw.Block])
-parseHtmlBlocks file =
-    withTheoryLexicon file \lexicon chunksByFile -> do
-        let parseChunk :: [Located Token] -> ([Raw.Block], Report Text [Located Token])
-            parseChunk = fullParses (parser (grammar lexicon))
-
-        blocksByFile <- for chunksByFile \(path, chunks) -> do
-            blocks <- fmap concat $ for chunks \toks ->
-                parseChunkResult (parseChunk toks)
-            pure (path, blocks)
-
-        rootBlocks <- case [blocks | (path, blocks) <- blocksByFile, path == file] of
-            [blocks] -> pure blocks
-            _ -> error ("parseHtmlBlocks: could not find token chunks for " <> file)
-
-        pure (rootBlocks, concatMap snd blocksByFile)
+parseHtmlBlocks file = do
+    result <- liftIO (parseDefaultWorkspace file)
+    workspace <- either throwWorkspaceError pure result
+    pure
+        ( Felix.parsedSourceBlocks (Felix.parsedWorkspaceRootNode workspace)
+        , Felix.importedBeforeImporterBlocks workspace
+        )
 
 data WithFilter = WithoutFilter | WithFilter deriving (Show, Eq)
 
diff --git a/source/Base.hs b/source/Base.hs
index b454553..4c6a670 100644
--- a/source/Base.hs
+++ b/source/Base.hs
@@ -48,6 +48,7 @@ import Data.Word as Export (Word64)
 import Debug.Trace as Export
 import GHC.Generics as Export (Generic(..), Generic1(..))
 import Prettyprinter as Export (pretty)
+import System.IO.Error as Export (isDoesNotExistError, tryIOError)
 import UnliftIO as Export (throwIO)
 
 -- | Signal to the developer that a branch is unreachable or represent
diff --git a/source/Felix/Parse.hs b/source/Felix/Parse.hs
new file mode 100644
index 0000000..e41f636
--- /dev/null
+++ b/source/Felix/Parse.hs
@@ -0,0 +1,251 @@
+{-# LANGUAGE DerivingStrategies #-}
+{-# LANGUAGE NoImplicitPrelude #-}
+
+-- | Parsing over an already resolved physical source graph.
+module Felix.Parse
+    ( ParseException(..)
+    , ParseWorkspaceError(..)
+    , ParsedSourceNode
+    , parsedSourceLoaded
+    , parsedSourceResolved
+    , parsedSourceBlocks
+    , ParsedSourceWorkspace
+    , parsedWorkspaceRoot
+    , parsedWorkspaceRootNode
+    , parsedWorkspaceNodes
+    , parsedWorkspaceImportEdges
+    , parsedWorkspaceImportedBeforeImporter
+    , importedBeforeImporterBlocks
+    , parseResolvedSourceGraph
+    , parseResolvedSourceGraphWith
+    ) where
+
+import Base
+import Felix.Source
+import Felix.Source.Graph
+import Report.Location
+import Syntax.Abstract qualified as Raw
+import Syntax.Adapt (adaptChunks)
+import Syntax.Concrete (grammar)
+import Syntax.Lexicon (Lexicon, builtins)
+import Syntax.Token
+
+import Control.Exception (Exception)
+import Control.Monad (foldM)
+import Control.Monad.Trans.Except (ExceptT(..), runExceptT, throwE)
+import Data.List (intercalate)
+import Data.List.NonEmpty qualified as NonEmpty
+import Data.Text qualified as Text
+import Text.Earley (Report(..), fullParses, parser)
+import Text.Megaparsec (errorBundlePretty)
+
+
+data ParseException
+    = UnconsumedTokens [Text] (NonEmpty (Located Token))
+    | AmbigousParse [Raw.Block]
+    | EmptyParse
+    | TokenError String
+
+instance Show ParseException where
+    show = \case
+        UnconsumedTokens expectations (locatedToken :| locatedTokens) ->
+            let token = unLocated locatedToken
+                tokens = unLocated <$> locatedTokens
+            in
+                "unconsumed " <> describeToken token <> " at "
+                    <> prettyLocation (startPos locatedToken) <> "\n"
+                    <> "  " <> unwords (tokToString <$> (token : take 4 tokens)) <> "\n"
+                    <> "  " <> replicate (length (tokToString token)) '^' <> "\n"
+                    <> case expectations of
+                        [] ->
+                            "while expecting nothing"
+                        _ ->
+                            "while expecting one of the following:\n"
+                                <> intercalate ", "
+                                    (Text.unpack <$> nubOrd expectations)
+        AmbigousParse blocks ->
+            "ambiguous parse: " <> show blocks
+        EmptyParse ->
+            "empty parse"
+        TokenError err ->
+            err
+
+instance Exception ParseException
+
+
+data ParseWorkspaceError
+    = SourceWorkspaceError !SourceError
+    | SourceParseError !ResolvedSource !ParseException
+    deriving stock (Show)
+
+instance Exception ParseWorkspaceError
+
+
+data ParsedSourceNode = ParsedSourceNode
+    !LoadedSource
+    ![Raw.Block]
+    deriving stock (Show)
+
+parsedSourceLoaded :: ParsedSourceNode -> LoadedSource
+parsedSourceLoaded (ParsedSourceNode loaded _blocks) = loaded
+
+parsedSourceResolved :: ParsedSourceNode -> ResolvedSource
+parsedSourceResolved = loadedSource . parsedSourceLoaded
+
+parsedSourceBlocks :: ParsedSourceNode -> [Raw.Block]
+parsedSourceBlocks (ParsedSourceNode _loaded blocks) = blocks
+
+
+data ParsedSourceWorkspace = ParsedSourceWorkspace
+    !(NonEmpty ParsedSourceNode)
+    ![SourceImportEdge]
+    deriving stock (Show)
+
+parsedWorkspaceRoot :: ParsedSourceWorkspace -> ResolvedSource
+parsedWorkspaceRoot = parsedSourceResolved . parsedWorkspaceRootNode
+
+parsedWorkspaceRootNode :: ParsedSourceWorkspace -> ParsedSourceNode
+parsedWorkspaceRootNode (ParsedSourceWorkspace nodes _edges) =
+    NonEmpty.last nodes
+
+parsedWorkspaceNodes :: ParsedSourceWorkspace -> [ParsedSourceNode]
+parsedWorkspaceNodes (ParsedSourceWorkspace nodes _edges) =
+    NonEmpty.toList nodes
+
+parsedWorkspaceImportEdges :: ParsedSourceWorkspace -> [SourceImportEdge]
+parsedWorkspaceImportEdges (ParsedSourceWorkspace _nodes edges) =
+    edges
+
+parsedWorkspaceImportedBeforeImporter
+    :: ParsedSourceWorkspace
+    -> NonEmpty ParsedSourceNode
+parsedWorkspaceImportedBeforeImporter (ParsedSourceWorkspace nodes _edges) =
+    nodes
+
+-- | Flatten source-local blocks in deterministic imported-before-importer
+-- order.
+importedBeforeImporterBlocks :: ParsedSourceWorkspace -> [Raw.Block]
+importedBeforeImporterBlocks =
+    concatMap parsedSourceBlocks . parsedWorkspaceImportedBeforeImporter
+
+
+data TokenizedSourceNode = TokenizedSourceNode
+    !SourceNode
+    ![[Located Token]]
+
+parseResolvedSourceGraph
+    :: ResolvedSourceGraph
+    -> IO (Either ParseWorkspaceError ParsedSourceWorkspace)
+parseResolvedSourceGraph graph =
+    parseResolvedSourceGraphWith graph (\_source _block -> pure ())
+
+-- | Parse in the graph's deterministic imported-before-importer order.
+--
+-- Graph construction errors occur before this order exists.
+--
+-- The callback is invoked as each chunk is parsed, preserving the current
+-- parser/checker streaming boundary.  Every source is tokenized from its
+-- already loaded text; this function performs no source resolution or I/O.
+parseResolvedSourceGraphWith
+    :: ResolvedSourceGraph
+    -> (ResolvedSource -> Raw.Block -> IO ())
+    -> IO (Either ParseWorkspaceError ParsedSourceWorkspace)
+parseResolvedSourceGraphWith graph emitBlock =
+    runExceptT do
+        let orderedNodes =
+                sourceGraphImportedBeforeImporter graph
+        orderedTokenized <- traverse
+            (ExceptT . tokenizeSourceNode)
+            orderedNodes
+        let lexicon = foldl' adaptNode builtins orderedTokenized
+        lexicon `seq` pure ()
+        parsedNodes <- traverse
+            (parseTokenizedNode lexicon emitBlock)
+            orderedTokenized
+        pure
+            (ParsedSourceWorkspace
+                parsedNodes
+                (sourceGraphImportEdges graph))
+
+tokenizeSourceNode
+    :: SourceNode
+    -> IO (Either ParseWorkspaceError TokenizedSourceNode)
+tokenizeSourceNode node = do
+    let loaded = sourceNodeLoaded node
+        source = loadedSource loaded
+        locationPath = resolvedSourceLocationPath source
+    pure case
+        runLexer
+            (sourceNodeFileId node)
+            locationPath
+            (loadedText loaded) of
+        Left err ->
+            Left
+                (SourceParseError
+                    source
+                    (TokenError (errorBundlePretty err)))
+        Right (_imports, chunks) ->
+            Right (TokenizedSourceNode node chunks)
+
+adaptNode :: Lexicon -> TokenizedSourceNode -> Lexicon
+adaptNode lexicon (TokenizedSourceNode _node chunks) =
+    adaptChunks chunks lexicon
+
+parseTokenizedNode
+    :: Lexicon
+    -> (ResolvedSource -> Raw.Block -> IO ())
+    -> TokenizedSourceNode
+    -> ExceptT ParseWorkspaceError IO ParsedSourceNode
+parseTokenizedNode lexicon emitBlock (TokenizedSourceNode node chunks) = do
+    reversedBlocks <- foldM parseChunk [] chunks
+    pure
+        (ParsedSourceNode
+            (sourceNodeLoaded node)
+            (reverse reversedBlocks))
+  where
+    source = sourceNodeResolved node
+
+    parseChunk currentReversed tokens =
+        case parseChunkResult
+            (fullParses (parser (grammar lexicon)) tokens) of
+            Left err ->
+                throwE (SourceParseError source err)
+            Right blocks -> do
+                liftIO (traverse_ (emitBlock source) blocks)
+                pure
+                    (foldl'
+                        (flip (:))
+                        currentReversed
+                        blocks)
+
+parseChunkResult
+    :: ([Raw.Block], Report Text [Located Token])
+    -> Either ParseException [Raw.Block]
+parseChunkResult = \case
+    (_, Report _ expectations (token : tokens)) ->
+        Left (UnconsumedTokens expectations (token :| tokens))
+    ([], _) ->
+        Left EmptyParse
+    (ambiguous@(_ : _ : _), _) ->
+        case nubOrd ambiguous of
+            [block] ->
+                Right
+                    [trace
+                        ("technically ambiguous parse:\n" <> show block)
+                        block]
+            distinct ->
+                Left (AmbigousParse distinct)
+    ([block], _) ->
+        Right [block]
+
+
+describeToken :: Token -> String
+describeToken = \case
+    Word _ -> "word"
+    Variable _ -> "variable"
+    Symbol _ -> "symbol"
+    Integer _ -> "integer"
+    Command _ -> "command"
+    BeginEnv _ -> "begin of environment"
+    EndEnv _ -> "end of environment"
+    _ -> "delimiter"
diff --git a/source/Felix/Source.hs b/source/Felix/Source.hs
index 5ea9cf6..203b61a 100644
--- a/source/Felix/Source.hs
+++ b/source/Felix/Source.hs
@@ -29,6 +29,7 @@ module Felix.Source
     , resolvedSourceCanonicalPath
     , resolvedSourceMount
     , resolvedSourceRelativePath
+    , resolvedSourceLocationPath
     , LoadedSource
     , loadedSource
     , loadedText
@@ -41,9 +42,17 @@ module Felix.Source
     , sourceCandidatePath
     , sourceCandidates
     , attributeCanonicalSource
+    , resolveRoot
+    , resolveImport
+    , loadResolvedSource
     , resolveAndLoadRoot
     , resolveAndLoadImport
     , SourceLookup(..)
+    , SourceCycleStep
+    , sourceCycleStep
+    , cycleImporter
+    , cycleImport
+    , cycleImported
     , RelativePathError(..)
     , SourceError(..)
     ) where
@@ -58,9 +67,10 @@ import Data.Map.Strict qualified as Map
 import Data.Set qualified as Set
 import Data.Text qualified as Text
 import Data.Text.Encoding qualified as Encoding
-import Report.Location (Location)
+import Report.Location (Location, LocationRegistrationError)
 import System.Directory qualified as Directory
 import System.FilePath.Posix qualified as Posix
+import System.Posix.Files qualified as PosixFiles
 
 
 -- | Invocation-local name of a configured source mount.
@@ -172,12 +182,28 @@ existingRoot path
     | not (Posix.isAbsolute path) =
         pure (Left (ExistingRootNotAbsolute path))
     | otherwise = do
-        exists <- Directory.doesFileExist path
-        if not exists
-            then pure (Left (ExistingRootUnavailable path))
-            else
-                fmap (\canonical -> ExistingRoot canonical path) <$>
-                    canonicalize ExistingRootCanonicalizationFailed path
+        statusResult <- try (PosixFiles.getFileStatus path)
+            :: IO (Either IOException PosixFiles.FileStatus)
+        case statusResult of
+            Left err
+                | isDoesNotExistError err ->
+                    pure (Left (ExistingRootUnavailable path))
+                | otherwise ->
+                    pure
+                        (Left
+                            (ExistingRootInspectionFailed
+                                path
+                                (Text.pack (displayException err))))
+            Right status
+                | not (PosixFiles.isRegularFile status) -> do
+                    canonicalized <-
+                        canonicalize ExistingRootCanonicalizationFailed path
+                    pure
+                        (canonicalized >>= \canonical ->
+                            Left (ExistingRootNotRegular path canonical))
+                | otherwise ->
+                    fmap (\canonical -> ExistingRoot canonical path) <$>
+                        canonicalize ExistingRootCanonicalizationFailed path
 
 -- | The user-facing spelling retained only for diagnostics.
 rootRequestSpelling :: RootRequest -> FilePath
@@ -203,6 +229,14 @@ resolvedSourceMount (ResolvedSource _path mount _relative) = mount
 resolvedSourceRelativePath :: ResolvedSource -> SafeRelativePath
 resolvedSourceRelativePath (ResolvedSource _path _mount relative) = relative
 
+-- | Stable mount-relative spelling for locations in one resolved workspace.
+-- This is derived from the selected source rather than its request or import
+-- spelling.
+resolvedSourceLocationPath :: ResolvedSource -> FilePath
+resolvedSourceLocationPath =
+    safeRelativePathFilePath . resolvedSourceRelativePath
+
+
 data LoadedSource = LoadedSource
     !ResolvedSource
     !Text
@@ -258,6 +292,28 @@ data SourceLookup
     | ImportedSourceLookup !ResolvedSource !ImportRef
     deriving stock (Show, Eq)
 
+data SourceCycleStep = SourceCycleStep
+    !ResolvedSource
+    !ImportRef
+    !ResolvedSource
+    deriving stock (Show, Eq)
+
+sourceCycleStep
+    :: ResolvedSource
+    -> ImportRef
+    -> ResolvedSource
+    -> SourceCycleStep
+sourceCycleStep = SourceCycleStep
+
+cycleImporter :: SourceCycleStep -> ResolvedSource
+cycleImporter (SourceCycleStep importer _reference _imported) = importer
+
+cycleImport :: SourceCycleStep -> ImportRef
+cycleImport (SourceCycleStep _importer reference _imported) = reference
+
+cycleImported :: SourceCycleStep -> ResolvedSource
+cycleImported (SourceCycleStep _importer _reference imported) = imported
+
 
 data SourceError
     = EmptySourceMountTable
@@ -271,6 +327,8 @@ data SourceError
     | ExistingRootNotAbsolute !FilePath
     | ExistingRootUnavailable !FilePath
     | ExistingRootCanonicalizationFailed !FilePath !Text
+    | ExistingRootInspectionFailed !FilePath !Text
+    | ExistingRootNotRegular !FilePath !CanonicalPath
     | RootOutsideConfiguredMount !FilePath !CanonicalPath
     | InvalidAttributedRelativePath
         !CanonicalPath
@@ -281,14 +339,31 @@ data SourceError
         !SourceLookup
         !FilePath
         !Text
-    | SelectedSourceUnavailable !SourceLookup !CanonicalPath
+    | SelectedSourceInspectionFailed
+        !SourceLookup
+        !FilePath
+        !Text
+    | SelectedSourceNotRegular
+        !SourceLookup
+        !FilePath
+        !CanonicalPath
     | InvalidImportPath
         !ResolvedSource
         !Location
         !FilePath
         !RelativePathError
     | SourceReadFailed !ResolvedSource !Text
+    | SourceReadTargetNotRegular !ResolvedSource
     | SourceDecodeError !ResolvedSource !Int
+    | SourceImportDiscoveryFailed !ResolvedSource !Text
+    | SourceLocationRegistrationFailed
+        !ResolvedSource
+        !LocationRegistrationError
+    | DirectSourceLocationRegistrationFailed
+        !FilePath
+        !LocationRegistrationError
+    | SourceImportCycle !(NonEmpty SourceCycleStep)
+    | SourceGraphInvariantViolation !Text
     deriving stock (Show, Eq)
 
 instance Exception SourceError
@@ -428,11 +503,7 @@ resolveAndLoadImport
     -> ImportRef
     -> IO (Either SourceError LoadedSource)
 resolveAndLoadImport mounts importer reference =
-    resolveAndLoad
-        (resolveSearched
-            mounts
-            (ImportedSourceLookup importer reference)
-            (importPath reference))
+    resolveAndLoad (resolveImport mounts importer reference)
 
 resolveAndLoad
     :: IO (Either SourceError ResolvedSource)
@@ -452,11 +523,19 @@ resolveRoot
 resolveRoot mounts = \case
     SearchedRoot path ->
         resolveSearched mounts (SearchedRootLookup path) path
-    ExistingRoot canonical spelling -> do
-        exists <- Directory.doesFileExist (canonicalPathFilePath canonical)
-        if exists
-            then pure (attributeSelectedSource spelling mounts canonical)
-            else pure (Left (ExistingRootUnavailable spelling))
+    ExistingRoot canonical spelling ->
+        pure (attributeSelectedSource spelling mounts canonical)
+
+resolveImport
+    :: SourceMounts
+    -> ResolvedSource
+    -> ImportRef
+    -> IO (Either SourceError ResolvedSource)
+resolveImport mounts importer reference =
+    resolveSearched
+        mounts
+        (ImportedSourceLookup importer reference)
+        (importPath reference)
 
 resolveSearched
     :: SourceMounts
@@ -471,10 +550,22 @@ resolveSearched mounts lookupKind relative =
     choose [] =
         pure (Left (SourceNotFound lookupKind candidates))
     choose (candidate : rest) = do
-        exists <- Directory.doesFileExist (sourceCandidatePath candidate)
-        if exists
-            then resolveCandidate mounts lookupKind candidate
-            else choose rest
+        let path = sourceCandidatePath candidate
+        statusResult <- try (PosixFiles.getSymbolicLinkStatus path)
+            :: IO (Either IOException PosixFiles.FileStatus)
+        case statusResult of
+            Left err
+                | isDoesNotExistError err ->
+                    choose rest
+                | otherwise ->
+                    pure
+                        (Left
+                            (SelectedSourceInspectionFailed
+                                lookupKind
+                                path
+                                (Text.pack (displayException err))))
+            Right _status ->
+                resolveCandidate mounts lookupKind candidate
 
 resolveCandidate
     :: SourceMounts
@@ -490,15 +581,29 @@ resolveCandidate mounts lookupKind candidate = do
         Left err ->
             pure (Left err)
         Right canonical -> do
-            stillExists <- Directory.doesFileExist (canonicalPathFilePath canonical)
-            if stillExists
-                then
-                    pure
-                        (attributeSelectedSource
+            statusResult <- try
+                (PosixFiles.getFileStatus
+                    (canonicalPathFilePath canonical))
+                :: IO (Either IOException PosixFiles.FileStatus)
+            pure case statusResult of
+                Left err ->
+                    Left
+                        (SelectedSourceInspectionFailed
+                            lookupKind
+                            (sourceCandidatePath candidate)
+                            (Text.pack (displayException err)))
+                Right status
+                    | not (PosixFiles.isRegularFile status) ->
+                        Left
+                            (SelectedSourceNotRegular
+                                lookupKind
+                                (sourceCandidatePath candidate)
+                                canonical)
+                    | otherwise ->
+                        attributeSelectedSource
                             (sourceCandidatePath candidate)
                             mounts
-                            canonical)
-                else pure (Left (SelectedSourceUnavailable lookupKind canonical))
+                            canonical
 
 attributeSelectedSource
     :: FilePath
@@ -516,18 +621,38 @@ attributeSelectedSource spelling mounts canonical =
 
 loadResolvedSource :: ResolvedSource -> IO (Either SourceError LoadedSource)
 loadResolvedSource source = do
-    bytesResult <- try
-        (ByteString.readFile
-            (canonicalPathFilePath (resolvedSourceCanonicalPath source)))
-        :: IO (Either IOException ByteString.ByteString)
-    pure case bytesResult of
+    let path =
+            canonicalPathFilePath (resolvedSourceCanonicalPath source)
+    statusResult <- try (PosixFiles.getFileStatus path)
+        :: IO (Either IOException PosixFiles.FileStatus)
+    case statusResult of
         Left err ->
-            Left (SourceReadFailed source (Text.pack (displayException err)))
-        Right bytes ->
-            case Encoding.decodeUtf8' bytes of
-                Left _ ->
-                    let (validPrefixLength, _state) =
-                            Encoding.validateUtf8Chunk bytes
-                    in Left (SourceDecodeError source validPrefixLength)
-                Right text ->
-                    Right (LoadedSource source text)
+            pure
+                (Left
+                    (SourceReadFailed
+                        source
+                        (Text.pack (displayException err))))
+        Right status
+            | not (PosixFiles.isRegularFile status) ->
+                pure (Left (SourceReadTargetNotRegular source))
+            | otherwise -> do
+                bytesResult <- try (ByteString.readFile path)
+                    :: IO (Either IOException ByteString.ByteString)
+                pure case bytesResult of
+                    Left err ->
+                        Left
+                            (SourceReadFailed
+                                source
+                                (Text.pack (displayException err)))
+                    Right bytes ->
+                        case Encoding.decodeUtf8' bytes of
+                            Left _ ->
+                                let (validPrefixLength, _state) =
+                                        Encoding.validateUtf8Chunk bytes
+                                in
+                                    Left
+                                        (SourceDecodeError
+                                            source
+                                            validPrefixLength)
+                            Right text ->
+                                Right (LoadedSource source text)
diff --git a/source/Felix/Source/Graph.hs b/source/Felix/Source/Graph.hs
new file mode 100644
index 0000000..e359156
--- /dev/null
+++ b/source/Felix/Source/Graph.hs
@@ -0,0 +1,349 @@
+{-# LANGUAGE DerivingStrategies #-}
+{-# LANGUAGE NoImplicitPrelude #-}
+
+-- | A freshly resolved physical source graph.
+--
+-- Nodes are selected canonical files. Import edges retain every source
+-- occurrence, including repeated imports that reach the same node.
+module Felix.Source.Graph
+    ( SourceNode
+    , sourceNodeLoaded
+    , sourceNodeResolved
+    , sourceNodeFileId
+    , SourceImportEdge
+    , sourceImportingNode
+    , sourceImportReference
+    , sourceImportedNode
+    , ResolvedSourceGraph
+    , sourceGraphRoot
+    , sourceGraphRootSource
+    , sourceGraphNodes
+    , sourceGraphImportEdges
+    , sourceGraphImportedBeforeImporter
+    , buildResolvedSourceGraph
+    ) where
+
+import Base
+import Felix.Source
+import Report.Location
+    ( FileId
+    , registerFilePathWithDisplay
+    )
+import Syntax.Token (Located(..), gatherImports)
+
+import Control.Monad (unless)
+import Control.Monad.State.Strict
+    ( StateT
+    , get
+    , gets
+    , modify'
+    , runStateT
+    )
+import Control.Monad.Trans.Except (ExceptT, runExceptT, throwE)
+import Data.List qualified as List
+import Data.List.NonEmpty qualified as NonEmpty
+import Data.Map.Strict qualified as Map
+import Data.Text qualified as Text
+import Text.Megaparsec (errorBundlePretty)
+
+
+data SourceNode = SourceNode
+    !LoadedSource
+    !FileId
+    deriving stock (Show, Eq)
+
+sourceNodeLoaded :: SourceNode -> LoadedSource
+sourceNodeLoaded (SourceNode loaded _fileId) = loaded
+
+sourceNodeResolved :: SourceNode -> ResolvedSource
+sourceNodeResolved = loadedSource . sourceNodeLoaded
+
+sourceNodeFileId :: SourceNode -> FileId
+sourceNodeFileId (SourceNode _loaded fileId) = fileId
+
+sourceNodeCanonicalPath :: SourceNode -> CanonicalPath
+sourceNodeCanonicalPath =
+    resolvedSourceCanonicalPath . sourceNodeResolved
+
+
+data SourceImportEdge = SourceImportEdge
+    !CanonicalPath
+    !ImportRef
+    !CanonicalPath
+    deriving stock (Show, Eq)
+
+sourceImportingNode :: SourceImportEdge -> CanonicalPath
+sourceImportingNode (SourceImportEdge importer _reference _imported) =
+    importer
+
+sourceImportReference :: SourceImportEdge -> ImportRef
+sourceImportReference (SourceImportEdge _importer reference _imported) =
+    reference
+
+sourceImportedNode :: SourceImportEdge -> CanonicalPath
+sourceImportedNode (SourceImportEdge _importer _reference imported) =
+    imported
+
+
+data ResolvedSourceGraph = ResolvedSourceGraph
+    !(NonEmpty SourceNode)
+    ![SourceImportEdge]
+    deriving stock (Show)
+
+sourceGraphRoot :: ResolvedSourceGraph -> CanonicalPath
+sourceGraphRoot =
+    sourceNodeCanonicalPath . NonEmpty.last . sourceGraphNodeSpine
+
+sourceGraphRootSource :: ResolvedSourceGraph -> ResolvedSource
+sourceGraphRootSource =
+    sourceNodeResolved . NonEmpty.last . sourceGraphNodeSpine
+
+sourceGraphNodes :: ResolvedSourceGraph -> [SourceNode]
+sourceGraphNodes =
+    NonEmpty.toList . sourceGraphNodeSpine
+
+sourceGraphImportEdges :: ResolvedSourceGraph -> [SourceImportEdge]
+sourceGraphImportEdges (ResolvedSourceGraph _nodes edges) =
+    edges
+
+-- | Deterministic DFS completion order. Imports are visited in textual
+-- occurrence order, so every imported node precedes its importer and sibling
+-- imports retain their source order.
+sourceGraphImportedBeforeImporter :: ResolvedSourceGraph -> NonEmpty SourceNode
+sourceGraphImportedBeforeImporter =
+    sourceGraphNodeSpine
+
+sourceGraphNodeSpine :: ResolvedSourceGraph -> NonEmpty SourceNode
+sourceGraphNodeSpine (ResolvedSourceGraph nodes _edges) =
+    nodes
+
+
+data VisitStatus
+    = Visiting
+    | Visited
+    deriving stock (Show, Eq)
+
+data BuildNode = BuildNode
+    !SourceNode
+    !VisitStatus
+
+data GraphBuildState = GraphBuildState
+    { buildNodes :: !(Map CanonicalPath BuildNode)
+    , buildEdgesReversed :: ![SourceImportEdge]
+    , buildOrderReversed :: ![SourceNode]
+    }
+
+type GraphBuilder = ExceptT SourceError (StateT GraphBuildState IO)
+
+initialGraphBuildState :: GraphBuildState
+initialGraphBuildState = GraphBuildState
+    { buildNodes = mempty
+    , buildEdgesReversed = []
+    , buildOrderReversed = []
+    }
+
+buildResolvedSourceGraph
+    :: SourceMounts
+    -> RootRequest
+    -> IO (Either SourceError ResolvedSourceGraph)
+buildResolvedSourceGraph mounts request = do
+    resolvedRoot <- resolveRoot mounts request
+    case resolvedRoot of
+        Left err ->
+            pure (Left err)
+        Right rootSource -> do
+            loadedRoot <- loadResolvedSource rootSource
+            case loadedRoot of
+                Left err ->
+                    pure (Left err)
+                Right root -> do
+                    (result, finalState) <- runStateT
+                        (runExceptT do
+                            rootNode <- insertFreshNode root
+                            visitNode
+                                mounts
+                                (sourceNodeCanonicalPath rootNode)
+                                [])
+                        initialGraphBuildState
+                    pure case result of
+                        Left err ->
+                            Left err
+                        Right () ->
+                            case NonEmpty.nonEmpty
+                                (reverse (buildOrderReversed finalState)) of
+                                Nothing ->
+                                    Left
+                                        (SourceGraphInvariantViolation
+                                            "source graph has no root node")
+                                Just order ->
+                                    Right
+                                        (ResolvedSourceGraph
+                                            order
+                                            (reverse
+                                                (buildEdgesReversed
+                                                    finalState)))
+
+insertFreshNode :: LoadedSource -> GraphBuilder SourceNode
+insertFreshNode loaded = do
+    state <- get
+    let source = loadedSource loaded
+        canonical = resolvedSourceCanonicalPath source
+    case Map.lookup canonical (buildNodes state) of
+        Just _ ->
+            throwE
+                (SourceGraphInvariantViolation
+                    "attempted to allocate a duplicate canonical source node")
+        Nothing -> do
+            let identityPath = canonicalPathFilePath canonical
+                displayPath = resolvedSourceLocationPath source
+            registration <- liftIO
+                (registerFilePathWithDisplay identityPath displayPath)
+            fileId <- either
+                (throwE . SourceLocationRegistrationFailed source)
+                pure
+                registration
+            let node = SourceNode loaded fileId
+            modify' \current ->
+                current
+                    { buildNodes =
+                        Map.insert
+                            canonical
+                            (BuildNode node Visiting)
+                            (buildNodes current)
+                    }
+            pure node
+
+visitNode
+    :: SourceMounts
+    -> CanonicalPath
+    -> [SourceCycleStep]
+    -> GraphBuilder ()
+visitNode mounts canonical path = do
+    node <- lookupBuildNode canonical
+    references <- discoverNodeImports node
+    traverse_ (visitImport mounts node path) references
+    modify' \state ->
+        state
+            { buildNodes =
+                Map.adjust
+                    (\(BuildNode currentNode _status) ->
+                        BuildNode currentNode Visited)
+                    canonical
+                    (buildNodes state)
+            , buildOrderReversed =
+                node : buildOrderReversed state
+            }
+
+lookupBuildNode :: CanonicalPath -> GraphBuilder SourceNode
+lookupBuildNode canonical = do
+    nodes <- gets buildNodes
+    case Map.lookup canonical nodes of
+        Nothing ->
+            throwE
+                (SourceGraphInvariantViolation
+                    "source graph contains an unknown canonical path")
+        Just (BuildNode node _status) ->
+            pure node
+
+discoverNodeImports :: SourceNode -> GraphBuilder [ImportRef]
+discoverNodeImports node = do
+    let loaded = sourceNodeLoaded node
+        source = loadedSource loaded
+        locationPath = resolvedSourceLocationPath source
+    locatedPaths <- case
+        gatherImports
+            (sourceNodeFileId node)
+            locationPath
+            (loadedText loaded) of
+        Left err ->
+            throwE
+                (SourceImportDiscoveryFailed
+                    source
+                    (Text.pack (errorBundlePretty err)))
+        Right paths ->
+            pure paths
+    traverse (validateImport source) locatedPaths
+
+validateImport
+    :: ResolvedSource
+    -> Located FilePath
+    -> GraphBuilder ImportRef
+validateImport source locatedPath =
+    case importRef (startPos locatedPath) (unLocated locatedPath) of
+        Left err ->
+            throwE
+                (InvalidImportPath
+                    source
+                    (startPos locatedPath)
+                    (unLocated locatedPath)
+                    err)
+        Right reference ->
+            pure reference
+
+visitImport
+    :: SourceMounts
+    -> SourceNode
+    -> [SourceCycleStep]
+    -> ImportRef
+    -> GraphBuilder ()
+visitImport mounts importerNode path reference = do
+    let importer = sourceNodeResolved importerNode
+        importerCanonical = sourceNodeCanonicalPath importerNode
+    imported <- liftEitherIO (resolveImport mounts importer reference)
+    let importedCanonical = resolvedSourceCanonicalPath imported
+    existing <- gets (Map.lookup importedCanonical . buildNodes)
+    case existing of
+        Nothing -> do
+            loaded <- liftEitherIO (loadResolvedSource imported)
+            importedNode <- insertFreshNode loaded
+            appendEdge importerCanonical reference importedCanonical
+            let step = sourceCycleStep importer reference imported
+            visitNode mounts (sourceNodeCanonicalPath importedNode) (path <> [step])
+        Just (BuildNode importedNode status) -> do
+            unless
+                (sourceNodeResolved importedNode == imported)
+                (throwE
+                    (SourceGraphInvariantViolation
+                        "canonical source attribution changed within one graph"))
+            appendEdge importerCanonical reference importedCanonical
+            case status of
+                Visited ->
+                    pure ()
+                Visiting -> do
+                    let step = sourceCycleStep importer reference imported
+                    case cycleSuffix imported (path <> [step]) of
+                        Just cycleSteps ->
+                            throwE (SourceImportCycle cycleSteps)
+                        Nothing ->
+                            throwE
+                                (SourceGraphInvariantViolation
+                                    "cycle target is absent from the DFS path")
+
+appendEdge
+    :: CanonicalPath
+    -> ImportRef
+    -> CanonicalPath
+    -> GraphBuilder ()
+appendEdge importer reference imported =
+    modify' \state ->
+        state
+            { buildEdgesReversed =
+                SourceImportEdge importer reference imported
+                    : buildEdgesReversed state
+            }
+
+cycleSuffix
+    :: ResolvedSource
+    -> [SourceCycleStep]
+    -> Maybe (NonEmpty SourceCycleStep)
+cycleSuffix repeatedSource path =
+    NonEmpty.nonEmpty
+        (List.dropWhile
+            ((/= resolvedSourceCanonicalPath repeatedSource)
+                . resolvedSourceCanonicalPath
+                . cycleImporter)
+            path)
+
+liftEitherIO :: IO (Either SourceError a) -> GraphBuilder a
+liftEitherIO action =
+    liftIO action >>= either throwE pure
diff --git a/source/Report/Location.hs b/source/Report/Location.hs
index 5afb319..9a95a4f 100644
--- a/source/Report/Location.hs
+++ b/source/Report/Location.hs
@@ -10,7 +10,7 @@ import Data.IORef (IORef, atomicModifyIORef', newIORef, readIORef)
 import Data.IntMap.Strict qualified as IntMap
 import Data.Map.Strict qualified as Map
 import Data.Text qualified as Text
-import Data.Word (Word16)
+import Data.Word (Word16, Word32)
 import System.IO.Unsafe (unsafePerformIO)
 
 -- | File identifier used in packed source locations.
@@ -27,47 +27,115 @@ newtype Location = Location
     } deriving stock (Eq, Ord, Generic)
       deriving anyclass (Hashable)
 
+data RegisteredFile = RegisteredFile
+    { registeredFileIdentity :: FilePath
+    , registeredFileDisplayPath :: FilePath
+    }
+
 data FileRegistry = FileRegistry
-    { pathToFileId :: Map FilePath FileId
-    , fileIdToPath :: IntMap FilePath
-    , nextFileId :: {-# UNPACK #-} !Word16
+    { registrationToFileId :: Map (FilePath, FilePath) FileId
+    , fileIdToFile :: IntMap RegisteredFile
+    , fileIdAllocator :: !FileIdAllocator
     }
 
+data LocationRegistrationError
+    = FileIdSpaceExhausted
+    deriving stock (Show, Eq)
+
+newtype FileIdAllocator = FileIdAllocator Word32
+    deriving stock (Show, Eq)
+
+initialFileIdAllocator :: FileIdAllocator
+initialFileIdAllocator = FileIdAllocator 0
+
+allocateFileId
+    :: FileIdAllocator
+    -> Either LocationRegistrationError (FileId, FileIdAllocator)
+allocateFileId (FileIdAllocator next)
+    | next >= fromIntegral (maxBound :: Word16) =
+        Left FileIdSpaceExhausted
+    | otherwise =
+        Right
+            ( FileId (fromIntegral next)
+            , FileIdAllocator (next + 1)
+            )
+
 initialFileRegistry :: FileRegistry
 initialFileRegistry = FileRegistry
-    { pathToFileId = mempty
-    , fileIdToPath = mempty
-    , nextFileId = 0
+    { registrationToFileId = mempty
+    , fileIdToFile = mempty
+    , fileIdAllocator = initialFileIdAllocator
     }
 
 fileRegistryRef :: IORef FileRegistry
 fileRegistryRef = unsafePerformIO (newIORef initialFileRegistry)
 {-# NOINLINE fileRegistryRef #-}
 
-registerFilePath :: MonadIO io => FilePath -> io FileId
-registerFilePath path = liftIO $
+registerFilePath
+    :: MonadIO io
+    => FilePath
+    -> io (Either LocationRegistrationError FileId)
+registerFilePath path =
+    registerFilePathWithDisplay path path
+
+-- | Register a file by physical identity while retaining a separate path for
+-- diagnostics. The identity must be stable and unique for the selected
+-- physical source. Distinct display paths receive distinct file identifiers so
+-- one workspace cannot inherit another workspace's presentation. Callers with
+-- only one path should use 'registerFilePath'.
+registerFilePathWithDisplay
+    :: MonadIO io
+    => FilePath
+    -> FilePath
+    -> io (Either LocationRegistrationError FileId)
+registerFilePathWithDisplay identity displayPath = liftIO $
     atomicModifyIORef' fileRegistryRef \registry ->
-        case Map.lookup path (pathToFileId registry) of
+        case Map.lookup registration (registrationToFileId registry) of
             Just fileId ->
-                (registry, fileId)
+                (registry, Right fileId)
             Nothing ->
-                if nextFileId registry == maxBound
-                    then error "registerFilePath: exhausted file-id space (16 bits)"
-                    else
-                        let fileId = FileId (nextFileId registry)
-                            fileIdInt = fromIntegral (unFileId fileId)
+                case allocateFileId (fileIdAllocator registry) of
+                    Left err ->
+                        (registry, Left err)
+                    Right (fileId, nextAllocator) ->
+                        let fileIdInt = fromIntegral (unFileId fileId)
+                            registeredFile =
+                                RegisteredFile identity displayPath
                             registry' = FileRegistry
-                                { pathToFileId = Map.insert path fileId (pathToFileId registry)
-                                , fileIdToPath = IntMap.insert fileIdInt path (fileIdToPath registry)
-                                , nextFileId = nextFileId registry + 1
+                                { registrationToFileId =
+                                    Map.insert
+                                        registration
+                                        fileId
+                                        (registrationToFileId registry)
+                                , fileIdToFile =
+                                    IntMap.insert
+                                        fileIdInt
+                                        registeredFile
+                                        (fileIdToFile registry)
+                                , fileIdAllocator = nextAllocator
                                 }
                         in
-                            (registry', fileId)
+                            (registry', Right fileId)
+  where
+    registration = (identity, displayPath)
 
 lookupFilePath :: FileId -> Maybe FilePath
 lookupFilePath fileId = unsafePerformIO do
     registry <- readIORef fileRegistryRef
-    pure (IntMap.lookup (fromIntegral (unFileId fileId)) (fileIdToPath registry))
+    pure
+        (registeredFileDisplayPath <$>
+            IntMap.lookup
+                (fromIntegral (unFileId fileId))
+                (fileIdToFile registry))
+
+lookupFileIdentityPath :: FileId -> Maybe FilePath
+lookupFileIdentityPath fileId = unsafePerformIO do
+    registry <- readIORef fileRegistryRef
+    pure
+        (registeredFileIdentity <$>
+            IntMap.lookup
+                (fromIntegral (unFileId fileId))
+                (fileIdToFile registry))
 
 fileShift, lineShift :: Int
 fileShift = 48
diff --git a/source/Test/Unit/Html.hs b/source/Test/Unit/Html.hs
index efad358..e379c77 100644
--- a/source/Test/Unit/Html.hs
+++ b/source/Test/Unit/Html.hs
@@ -116,7 +116,11 @@ importedDatatypeDerivedFactPreviews = do
 
 fileLocation :: FilePath -> IO Location
 fileLocation path = do
-    fileId <- registerFilePath path
+    registration <- registerFilePath path
+    fileId <- either
+        (assertFailure . ("location registration failed: " <>) . show)
+        pure
+        registration
     pure (mkLocation fileId 1 1)
 
 propformDatatypeBlock :: Location -> Block
diff --git a/source/Test/Unit/Source.hs b/source/Test/Unit/Source.hs
index 1a06d0f..f46dba2 100644
--- a/source/Test/Unit/Source.hs
+++ b/source/Test/Unit/Source.hs
@@ -4,13 +4,31 @@
 module Test.Unit.Source (unitTests) where
 
 import Base
+import Felix.Parse qualified as Parse
 import Felix.Source
+import Felix.Source.Graph
+import Report.Location
+    ( FileId(..)
+    , FileIdAllocator(..)
+    , Location
+    , LocationRegistrationError(..)
+    , allocateFileId
+    , locFile
+    , locFileId
+    , locLine
+    , lookupFileIdentityPath
+    )
+import Syntax.Abstract qualified as Raw
 
 import Control.Exception (bracket)
 import Data.ByteString qualified as ByteString
+import Data.IORef
+import Data.List qualified as List
+import Data.Word (Word16)
 import System.Directory qualified as Directory
 import System.FilePath.Posix qualified as Posix
 import System.IO (hClose, openTempFile)
+import System.Posix.Files qualified as PosixFiles
 import Test.Tasty
 import Test.Tasty.HUnit
 
@@ -25,10 +43,34 @@ unitTests = testGroup "Source resolution"
     , testCase "searched and exact roots share canonical identity" rootFormsShareIdentity
     , testCase "attributes nested sources to the most specific mount" attributesNestedSources
     , testCase "configured order selects searched candidates" candidateOrderSelectsWinner
+    , testCase "rejects a higher-priority special source"
+        rejectsHigherPrioritySpecialSource
     , testCase "rejects exact roots outside configured mounts" rejectsOutsideExactRoot
     , testCase "loads source text as strict UTF-8" loadsStrictUtf8
     , testCase "reports malformed UTF-8 sequence starts"
         reportsInvalidUtf8Offsets
+    , testCase "reserves the all-ones file identifier"
+        preservesReservedFileId
+    , testCase "builds an imported-before-importer source graph" buildsSourceGraph
+    , testCase "orders sibling imports by textual occurrence"
+        ordersSiblingImports
+    , testCase "orders shared dependencies before their importers"
+        ordersSharedDependencies
+    , testCase "retains repeated import-edge occurrences" retainsRepeatedImports
+    , testCase "deduplicates canonical source nodes" deduplicatesCanonicalNodes
+    , testCase "reports missing imports at their source location" reportsMissingImports
+    , testCase "rejects unsafe imports at their source location" rejectsUnsafeImports
+    , testCase "reports the located import cycle chain" reportsImportCycles
+    , testCase "rejects malformed imported source before discovery" rejectsMalformedImportedSource
+    , testCase "parses source-local blocks in graph order" parsesSourceGraph
+    , testCase "distinguishes same-relative sources by physical location"
+        distinguishesPhysicalSourceLocations
+    , testCase "retains each workspace location display path"
+        retainsWorkspaceLocationDisplayPath
+    , testCase "reports imported lexer errors before importer errors"
+        reportsImportedLexerErrorFirst
+    , testCase "parses loaded sources without rereading files" parsesWithoutRereading
+    , testCase "returns source-local parse failures" returnsSourceParseFailures
     ]
 
 validatesRelativePaths :: Assertion
@@ -162,6 +204,47 @@ candidateOrderSelectsWinner =
         assertEqual "first configured source" "first" (loadedText firstWinner)
         assertEqual "reversed configured source" "second" (loadedText secondWinner)
 
+rejectsHigherPrioritySpecialSource :: Assertion
+rejectsHigherPrioritySpecialSource =
+    withTemporaryDirectory "felix-source-special-precedence" \temp -> do
+        let higherRoot = temp Posix.</> "higher"
+            lowerRoot = temp Posix.</> "lower"
+            higherSource = higherRoot Posix.</> "entry.tex"
+            lowerSource = lowerRoot Posix.</> "entry.tex"
+        Directory.createDirectory higherRoot
+        Directory.createDirectory lowerRoot
+        PosixFiles.createNamedPipe higherSource PosixFiles.ownerModes
+        writeFile lowerSource "ordinary source"
+        mounts <- expectRight =<< prepareSourceMounts
+            [ (sourceMountId "higher", higherRoot)
+            , (sourceMountId "lower", lowerRoot)
+            ]
+        request <- expectRight (searchedRoot "entry.tex")
+        result <- resolveRoot mounts request
+        case result of
+            Left
+                (SelectedSourceNotRegular
+                    (SearchedRootLookup relative)
+                    selectedPath
+                    canonical) -> do
+                        assertEqual "searched path"
+                            "entry.tex"
+                            (safeRelativePathFilePath relative)
+                        assertEqual "selected higher candidate"
+                            higherSource
+                            selectedPath
+                        canonicalHigher <-
+                            Directory.canonicalizePath higherSource
+                        assertEqual "selected canonical target"
+                            canonicalHigher
+                            (canonicalPathFilePath canonical)
+            Left err ->
+                assertFailure
+                    ("expected SelectedSourceNotRegular, got " <> show err)
+            Right source ->
+                assertFailure
+                    ("expected special-source rejection, got " <> show source)
+
 rejectsOutsideExactRoot :: Assertion
 rejectsOutsideExactRoot =
     withTemporaryDirectory "felix-source-outside-root" \temp -> do
@@ -215,6 +298,441 @@ reportsInvalidUtf8Offsets =
         assertOffset "malformed sequence start" [0x61, 0xC3, 0x28] 1
         assertOffset "incomplete sequence start" [0x61, 0xC3] 1
 
+preservesReservedFileId :: Assertion
+preservesReservedFileId =
+    case allocateFileId boundaryAllocator of
+        Left err ->
+            assertFailure
+                ("could not allocate last available file id: " <> show err)
+        Right (fileId, exhaustedAllocator) -> do
+            assertEqual "last available file id"
+                (maxBound - 1)
+                (unFileId fileId)
+            assertBool "allocator returned reserved file id"
+                (unFileId fileId /= maxBound)
+            assertEqual "allocator reports exhaustion"
+                (Left FileIdSpaceExhausted)
+                (allocateFileId exhaustedAllocator)
+  where
+    boundaryAllocator =
+        FileIdAllocator
+            (fromIntegral (maxBound :: Word16) - 1)
+
+buildsSourceGraph :: Assertion
+buildsSourceGraph =
+    withTemporaryDirectory "felix-source-graph" \temp -> do
+        writeTheory (temp Posix.</> "shared.tex") [] "shared"
+        writeTheory (temp Posix.</> "entry.tex") ["shared.tex"] "entry"
+        mounts <- oneMount "project" temp
+        request <- expectRight (searchedRoot "entry.tex")
+        graph <- expectRight =<< buildResolvedSourceGraph mounts request
+        assertEqual "two source nodes" 2 (length (sourceGraphNodes graph))
+        case sourceGraphImportEdges graph of
+            [edge] -> do
+                assertEqual "root imports" (sourceGraphRoot graph) (sourceImportingNode edge)
+                assertEqual
+                    "imported-before-importer order"
+                    [sourceImportedNode edge, sourceGraphRoot graph]
+                    ( sourceNodeCanonicalPathForTest
+                        <$> toList
+                            (sourceGraphImportedBeforeImporter graph)
+                    )
+                assertEqual "import location line" 1
+                    (locLine (importLocation (sourceImportReference edge)))
+                assertEqual "selected location path" "entry.tex"
+                    (locFile (importLocation (sourceImportReference edge)))
+            edges ->
+                assertFailure ("expected one import edge, got " <> show edges)
+
+ordersSiblingImports :: Assertion
+ordersSiblingImports =
+    withTemporaryDirectory "felix-source-sibling-order" \temp -> do
+        writeTheory (temp Posix.</> "a.tex") [] "a"
+        writeTheory (temp Posix.</> "b.tex") [] "b"
+        writeTheory
+            (temp Posix.</> "entry.tex")
+            ["a.tex", "b.tex"]
+            "entry"
+        graph <- buildSearchedGraph temp "entry.tex"
+        order <- sourceGraphOrderPaths graph
+        assertEqual "DFS completion order"
+            ["a.tex", "b.tex", "entry.tex"]
+            order
+
+ordersSharedDependencies :: Assertion
+ordersSharedDependencies =
+    withTemporaryDirectory "felix-source-shared-order" \temp -> do
+        writeTheory (temp Posix.</> "shared.tex") [] "shared"
+        writeTheory (temp Posix.</> "a.tex") ["shared.tex"] "a"
+        writeTheory (temp Posix.</> "b.tex") ["shared.tex"] "b"
+        writeTheory
+            (temp Posix.</> "entry.tex")
+            ["a.tex", "b.tex"]
+            "entry"
+        graph <- buildSearchedGraph temp "entry.tex"
+        order <- sourceGraphOrderPaths graph
+        assertEqual "shared dependency occurs once before both importers"
+            ["shared.tex", "a.tex", "b.tex", "entry.tex"]
+            order
+
+retainsRepeatedImports :: Assertion
+retainsRepeatedImports =
+    withTemporaryDirectory "felix-source-repeated-import" \temp -> do
+        writeTheory (temp Posix.</> "shared.tex") [] "shared"
+        writeTheory
+            (temp Posix.</> "entry.tex")
+            ["shared.tex", "shared.tex"]
+            "entry"
+        graph <- buildSearchedGraph temp "entry.tex"
+        assertEqual "canonical node count" 2 (length (sourceGraphNodes graph))
+        assertEqual "repeated edge count" 2 (length (sourceGraphImportEdges graph))
+
+deduplicatesCanonicalNodes :: Assertion
+deduplicatesCanonicalNodes =
+    withTemporaryDirectory "felix-source-canonical-dedup" \temp -> do
+        let shared = temp Posix.</> "shared.tex"
+            alias = temp Posix.</> "alias.tex"
+        writeTheory shared [] "shared"
+        Directory.createFileLink shared alias
+        writeTheory
+            (temp Posix.</> "entry.tex")
+            ["shared.tex", "alias.tex"]
+            "entry"
+        graph <- buildSearchedGraph temp "entry.tex"
+        assertEqual "one node for symlink aliases" 2 (length (sourceGraphNodes graph))
+        case sourceGraphImportEdges graph of
+            [firstEdge, secondEdge] ->
+                assertEqual
+                    "both occurrences reach one node"
+                    (sourceImportedNode firstEdge)
+                    (sourceImportedNode secondEdge)
+            edges ->
+                assertFailure ("expected two import edges, got " <> show edges)
+
+reportsMissingImports :: Assertion
+reportsMissingImports =
+    withTemporaryDirectory "felix-source-missing-import" \temp -> do
+        writeFile
+            (temp Posix.</> "entry.tex")
+            (unlines
+                [ "% heading"
+                , "\\import{missing.tex}"
+                , theoryBlock "entry"
+                ])
+        mounts <- oneMount "project" temp
+        request <- expectRight (searchedRoot "entry.tex")
+        result <- buildResolvedSourceGraph mounts request
+        case result of
+            Left (SourceNotFound (ImportedSourceLookup _ reference) _candidates) -> do
+                assertEqual "missing import line" 2 (locLine (importLocation reference))
+                assertEqual "missing import source" "entry.tex"
+                    (locFile (importLocation reference))
+            Left err ->
+                assertFailure ("expected located SourceNotFound, got " <> show err)
+            Right graph ->
+                assertFailure ("expected missing-import rejection, got " <> show graph)
+
+rejectsUnsafeImports :: Assertion
+rejectsUnsafeImports =
+    withTemporaryDirectory "felix-source-unsafe-import" \temp -> do
+        writeTheory (temp Posix.</> "entry.tex") ["./shared.tex"] "entry"
+        mounts <- oneMount "project" temp
+        request <- expectRight (searchedRoot "entry.tex")
+        result <- buildResolvedSourceGraph mounts request
+        case result of
+            Left (InvalidImportPath _source location raw CurrentDirectoryComponent) -> do
+                assertEqual "raw import" "./shared.tex" raw
+                assertEqual "unsafe import line" 1 (locLine location)
+                assertEqual "unsafe import source" "entry.tex" (locFile location)
+            Left err ->
+                assertFailure ("expected InvalidImportPath, got " <> show err)
+            Right graph ->
+                assertFailure ("expected unsafe-import rejection, got " <> show graph)
+
+reportsImportCycles :: Assertion
+reportsImportCycles =
+    withTemporaryDirectory "felix-source-cycle" \temp -> do
+        writeTheory (temp Posix.</> "a.tex") ["b.tex"] "a"
+        writeTheory (temp Posix.</> "b.tex") ["a.tex"] "b"
+        mounts <- oneMount "project" temp
+        request <- expectRight (searchedRoot "a.tex")
+        result <- buildResolvedSourceGraph mounts request
+        case result of
+            Left (SourceImportCycle steps) -> do
+                assertEqual "cycle length" 2 (length steps)
+                assertEqual
+                    "cycle importer sequence"
+                    ["a.tex", "b.tex"]
+                    [ safeRelativePathFilePath
+                        (resolvedSourceRelativePath (cycleImporter step))
+                    | step <- toList steps
+                    ]
+                assertEqual
+                    "cycle import locations"
+                    ["a.tex", "b.tex"]
+                    [ locFile (importLocation (cycleImport step))
+                    | step <- toList steps
+                    ]
+            Left err ->
+                assertFailure ("expected SourceImportCycle, got " <> show err)
+            Right graph ->
+                assertFailure ("expected cycle rejection, got " <> show graph)
+
+rejectsMalformedImportedSource :: Assertion
+rejectsMalformedImportedSource =
+    withTemporaryDirectory "felix-source-import-utf8" \temp -> do
+        writeTheory (temp Posix.</> "entry.tex") ["bad.tex"] "entry"
+        ByteString.writeFile
+            (temp Posix.</> "bad.tex")
+            (ByteString.pack [0x61, 0xFF])
+        mounts <- oneMount "project" temp
+        request <- expectRight (searchedRoot "entry.tex")
+        result <- buildResolvedSourceGraph mounts request
+        case result of
+            Left (SourceDecodeError source offset) -> do
+                assertEqual "bad source" "bad.tex"
+                    (safeRelativePathFilePath (resolvedSourceRelativePath source))
+                assertEqual "bad byte offset" 1 offset
+            Left err ->
+                assertFailure ("expected SourceDecodeError, got " <> show err)
+            Right graph ->
+                assertFailure ("expected malformed-source rejection, got " <> show graph)
+
+parsesSourceGraph :: Assertion
+parsesSourceGraph =
+    withTemporaryDirectory "felix-source-parse" \temp -> do
+        writeTheory (temp Posix.</> "shared.tex") [] "shared"
+        writeTheory (temp Posix.</> "entry.tex") ["shared.tex"] "entry"
+        graph <- buildSearchedGraph temp "entry.tex"
+        emittedRef <- newIORef []
+        workspace <- expectRight =<<
+            Parse.parseResolvedSourceGraphWith graph
+                (\source _block ->
+                    modifyIORef'
+                        emittedRef
+                        (safeRelativePathFilePath
+                            (resolvedSourceRelativePath source) :))
+        assertEqual "two parsed source nodes" 2
+            (length (Parse.parsedWorkspaceNodes workspace))
+        assertEqual "one source-local block per node" [1, 1]
+            (toList
+                (length . Parse.parsedSourceBlocks
+                    <$> Parse.parsedWorkspaceImportedBeforeImporter workspace))
+        assertEqual "imported-before-importer source order"
+            ["shared.tex", "entry.tex"]
+            (toList
+                (safeRelativePathFilePath
+                    . resolvedSourceRelativePath
+                    . Parse.parsedSourceResolved
+                    <$> Parse.parsedWorkspaceImportedBeforeImporter workspace))
+        assertEqual "flattened block view" 2
+            (length (Parse.importedBeforeImporterBlocks workspace))
+        emitted <- reverse <$> readIORef emittedRef
+        assertEqual "streamed block order"
+            ["shared.tex", "entry.tex"]
+            emitted
+
+distinguishesPhysicalSourceLocations :: Assertion
+distinguishesPhysicalSourceLocations =
+    withTemporaryDirectory "felix-source-location-identity" \temp -> do
+        let projectRoot = temp Posix.</> "project"
+            libraryRoot = temp Posix.</> "library"
+            projectEntry = projectRoot Posix.</> "entry.tex"
+            libraryEntry = libraryRoot Posix.</> "entry.tex"
+        Directory.createDirectory projectRoot
+        Directory.createDirectory libraryRoot
+        writeTheory projectEntry ["entry.tex"] "project_entry"
+        writeTheory libraryEntry [] "library_entry"
+        mounts <- expectRight =<< prepareSourceMounts
+            [ (sourceMountId "library", libraryRoot)
+            , (sourceMountId "project", projectRoot)
+            ]
+        request <- expectRight =<< existingRoot projectEntry
+        graph <- expectRight =<< buildResolvedSourceGraph mounts request
+        workspace <- expectRight =<< Parse.parseResolvedSourceGraph graph
+        projectNode <- expectParsedMount "project" workspace
+        libraryNode <- expectParsedMount "library" workspace
+        let projectLocation = onlyAxiomLocation projectNode
+            libraryLocation = onlyAxiomLocation libraryNode
+        assertEqual "project display path" "entry.tex" (locFile projectLocation)
+        assertEqual "library display path" "entry.tex" (locFile libraryLocation)
+        projectFileId <- expectJust "project file id"
+            (locFileId projectLocation)
+        libraryFileId <- expectJust "library file id"
+            (locFileId libraryLocation)
+        assertBool "physical sources have distinct file ids"
+            (projectFileId /= libraryFileId)
+        canonicalProject <- Directory.canonicalizePath projectEntry
+        canonicalLibrary <- Directory.canonicalizePath libraryEntry
+        assertEqual "project physical location key"
+            (Just canonicalProject)
+            (lookupFileIdentityPath projectFileId)
+        assertEqual "library physical location key"
+            (Just canonicalLibrary)
+            (lookupFileIdentityPath libraryFileId)
+
+retainsWorkspaceLocationDisplayPath :: Assertion
+retainsWorkspaceLocationDisplayPath =
+    withTemporaryDirectory "felix-source-location-display" \temp -> do
+        let nested = temp Posix.</> "nested"
+            entry = nested Posix.</> "entry.tex"
+        Directory.createDirectory nested
+        writeTheory entry [] "entry"
+        outerMounts <- oneMount "project" temp
+        outerRequest <- expectRight (searchedRoot "nested/entry.tex")
+        outerGraph <- expectRight =<<
+            buildResolvedSourceGraph outerMounts outerRequest
+        outerWorkspace <- expectRight =<<
+            Parse.parseResolvedSourceGraph outerGraph
+        innerMounts <- oneMount "library" nested
+        innerRequest <- expectRight (searchedRoot "entry.tex")
+        innerGraph <- expectRight =<<
+            buildResolvedSourceGraph innerMounts innerRequest
+        innerWorkspace <- expectRight =<<
+            Parse.parseResolvedSourceGraph innerGraph
+        let outerLocation =
+                onlyAxiomLocation
+                    (Parse.parsedWorkspaceRootNode outerWorkspace)
+            innerLocation =
+                onlyAxiomLocation
+                    (Parse.parsedWorkspaceRootNode innerWorkspace)
+        assertEqual "outer-mount display path"
+            "nested/entry.tex"
+            (locFile outerLocation)
+        assertEqual "more-specific-mount display path"
+            "entry.tex"
+            (locFile innerLocation)
+        outerFileId <- expectJust "outer workspace file id"
+            (locFileId outerLocation)
+        innerFileId <- expectJust "inner workspace file id"
+            (locFileId innerLocation)
+        assertBool "distinct display registrations use distinct file ids"
+            (outerFileId /= innerFileId)
+        canonicalEntry <- Directory.canonicalizePath entry
+        assertEqual "outer physical location key"
+            (Just canonicalEntry)
+            (lookupFileIdentityPath outerFileId)
+        assertEqual "inner physical location key"
+            (Just canonicalEntry)
+            (lookupFileIdentityPath innerFileId)
+
+reportsImportedLexerErrorFirst :: Assertion
+reportsImportedLexerErrorFirst =
+    withTemporaryDirectory "felix-source-lexer-error-order" \temp -> do
+        let malformedSource = unlines
+                [ "\\begin{axiom}"
+                , "#"
+                , "\\end{axiom}"
+                ]
+        writeFile
+            (temp Posix.</> "imported.tex")
+            malformedSource
+        writeFile
+            (temp Posix.</> "entry.tex")
+            ("\\import{imported.tex}\n" <> malformedSource)
+        graph <- buildSearchedGraph temp "entry.tex"
+        result <- Parse.parseResolvedSourceGraph graph
+        case result of
+            Left (Parse.SourceParseError source (Parse.TokenError _err)) ->
+                assertEqual "first lexer error" "imported.tex"
+                    (safeRelativePathFilePath
+                        (resolvedSourceRelativePath source))
+            Left err ->
+                assertFailure ("expected lexer error, got " <> show err)
+            Right workspace ->
+                assertFailure ("expected lexer error, got " <> show workspace)
+
+parsesWithoutRereading :: Assertion
+parsesWithoutRereading =
+    withTemporaryDirectory "felix-source-no-reread" \temp -> do
+        let shared = temp Posix.</> "shared.tex"
+            entry = temp Posix.</> "entry.tex"
+        writeTheory shared [] "shared"
+        writeTheory entry ["shared.tex"] "entry"
+        graph <- buildSearchedGraph temp "entry.tex"
+        Directory.removeFile entry
+        Directory.removeFile shared
+        firstWorkspace <- expectRight =<< Parse.parseResolvedSourceGraph graph
+        secondWorkspace <- expectRight =<< Parse.parseResolvedSourceGraph graph
+        assertEqual "first flat projection" 2
+            (length (Parse.importedBeforeImporterBlocks firstWorkspace))
+        assertEqual "repeated downstream projection" 2
+            (length (Parse.importedBeforeImporterBlocks secondWorkspace))
+
+returnsSourceParseFailures :: Assertion
+returnsSourceParseFailures =
+    withTemporaryDirectory "felix-source-parse-error" \temp -> do
+        writeFile
+            (temp Posix.</> "entry.tex")
+            "\\begin{axiom}\n"
+        graph <- buildSearchedGraph temp "entry.tex"
+        result <- Parse.parseResolvedSourceGraph graph
+        case result of
+            Left (Parse.SourceParseError source _err) ->
+                assertEqual "failed source" "entry.tex"
+                    (safeRelativePathFilePath
+                        (resolvedSourceRelativePath source))
+            Left err ->
+                assertFailure ("expected SourceParseError, got " <> show err)
+            Right workspace ->
+                assertFailure ("expected parse failure, got " <> show workspace)
+
+buildSearchedGraph :: FilePath -> FilePath -> IO ResolvedSourceGraph
+buildSearchedGraph root path = do
+    mounts <- oneMount "project" root
+    request <- expectRight (searchedRoot path)
+    expectRight =<< buildResolvedSourceGraph mounts request
+
+sourceGraphOrderPaths :: ResolvedSourceGraph -> IO [FilePath]
+sourceGraphOrderPaths graph =
+    pure
+        [ safeRelativePathFilePath
+            (resolvedSourceRelativePath (sourceNodeResolved node))
+        | node <- toList (sourceGraphImportedBeforeImporter graph)
+        ]
+
+sourceNodeCanonicalPathForTest :: SourceNode -> CanonicalPath
+sourceNodeCanonicalPathForTest =
+    resolvedSourceCanonicalPath . sourceNodeResolved
+
+expectParsedMount
+    :: Text
+    -> Parse.ParsedSourceWorkspace
+    -> IO Parse.ParsedSourceNode
+expectParsedMount ident workspace =
+    case List.find
+        ((== sourceMountId ident)
+            . resolvedSourceMount
+            . Parse.parsedSourceResolved)
+        (Parse.parsedWorkspaceNodes workspace) of
+        Nothing ->
+            assertFailure ("missing parsed source mount " <> show ident)
+        Just node ->
+            pure node
+
+onlyAxiomLocation :: Parse.ParsedSourceNode -> Location
+onlyAxiomLocation node =
+    case Parse.parsedSourceBlocks node of
+        [Raw.BlockAxiom location _title _marker _axiom] ->
+            location
+        blocks ->
+            error ("expected one axiom block, got " <> show blocks)
+
+writeTheory :: FilePath -> [FilePath] -> String -> IO ()
+writeTheory path imports label =
+    writeFile path
+        (unlines
+            (["\\import{" <> imported <> "}" | imported <- imports]
+                <> [theoryBlock label]))
+
+theoryBlock :: String -> String
+theoryBlock label =
+    unlines
+        [ "\\begin{axiom}\\label{" <> label <> "}"
+        , "  $x = x$."
+        , "\\end{axiom}"
+        ]
+
 oneMount :: Text -> FilePath -> IO SourceMounts
 oneMount ident root =
     expectRight =<< prepareSourceMounts [(sourceMountId ident, root)]
@@ -241,6 +759,13 @@ expectRight = \case
     Right value ->
         pure value
 
+expectJust :: HasCallStack => String -> Maybe a -> IO a
+expectJust description = \case
+    Nothing ->
+        assertFailure ("expected " <> description)
+    Just value ->
+        pure value
+
 assertLeft :: (Eq e, Eq a, Show e, Show a, HasCallStack) => e -> Either e a -> Assertion
 assertLeft expected actual =
     assertEqual "expected Left value" (Left expected) actual