Add mermaid serialization of the trie from graph based typechecking

src/Compiler/Driver/GraphChecking/DependencyResolution.fs

@@ -158,7 +158,7 @@ let collectGhostDependencies (fileIndex: FileIndex) (trie: TrieNode) (queryTrie:
                         // We pick the lowest file index from the namespace to satisfy the type-checker for the open statement.
                         connectedFileIdx < fileIndex))
 
-let mkGraph (compilingFSharpCore: bool) (filePairs: FilePairMap) (files: FileInProject array) : Graph<FileIndex> =
+let mkGraph (compilingFSharpCore: bool) (filePairs: FilePairMap) (files: FileInProject array) : Graph<FileIndex> * TrieNode =
     // We know that implementation files backed by signatures cannot be depended upon.
     // Do not include them when building the Trie.
     let trieInput =
@@ -238,6 +238,9 @@ let mkGraph (compilingFSharpCore: bool) (filePairs: FilePairMap) (files: FileInP
 
             allDependencies
 
-    files
-    |> Array.Parallel.map (fun file -> file.Idx, findDependencies file)
-    |> readOnlyDict
+    let graph =
+        files
+        |> Array.Parallel.map (fun file -> file.Idx, findDependencies file)
+        |> readOnlyDict
+
+    graph, trie

src/Compiler/Driver/GraphChecking/DependencyResolution.fsi

@@ -16,7 +16,7 @@ val processOpenPath:
 /// <param name="compilingFSharpCore">"Are we compiling FSharp.Core?" - used to add extra dependencies for FSharp.Core that are not otherwise detectable.</param>
 /// <param name="filePairs">Maps the index of a signature file with the index of its implementation counterpart and vice versa.</param>
 /// <param name="files">The files inside a project.</param>
-/// <returns>A dictionary of FileIndex (alias for int)</returns>
+/// <returns>A tuple consisting of a dictionary of FileIndex (alias for int) and a Trie</returns>
 /// <remarks>
 /// <para>
 /// *The constructed graph is a supergraph of the "necessary" file dependency graph,
@@ -30,4 +30,5 @@ val processOpenPath:
 /// Hence this function cannot, as it stands, be used to help create a "reasonable" file ordering for an unordered set of files.
 /// </para>
 /// </remarks>
-val mkGraph: compilingFSharpCore: bool -> filePairs: FilePairMap -> files: FileInProject array -> Graph<FileIndex>
+val mkGraph:
+    compilingFSharpCore: bool -> filePairs: FilePairMap -> files: FileInProject array -> Graph<FileIndex> * TrieNode

src/Compiler/Driver/GraphChecking/TrieMapping.fs

@@ -1,6 +1,8 @@
 module internal FSharp.Compiler.GraphChecking.TrieMapping
 
 open System.Collections.Generic
+open System.Text
+open FSharp.Compiler.IO
 open FSharp.Compiler.Syntax
 
 [<RequireQualifiedAccess>]
@@ -297,3 +299,82 @@ and mkTrieForSynModuleSigDecl (fileIndex: FileIndex) (decl: SynModuleSigDecl) :
 
 let mkTrie (files: FileInProject array) : TrieNode =
     mergeTrieNodes 0 (files |> Array.Parallel.map mkTrieNodeFor)
+
+type MermaidBoxPos =
+    | First
+    | Second
+
+let serializeToMermaid (path: string) (filesInProject: FileInProject array) (trie: TrieNode) =
+    let sb = StringBuilder()
+    let appendLine (line: string) = sb.AppendLine(line) |> ignore
+    let discovered = HashSet<TrieNodeInfo>()
+
+    let getName (node: TrieNodeInfo) =
+        match node with
+        | Root _ -> "root"
+        | Module (name, _) -> $"mod_{name}"
+        | Namespace (name, _, _) -> $"ns_{name}"
+
+    let toBoxList (boxPos: MermaidBoxPos) (files: HashSet<FileIndex>) =
+        let sb = StringBuilder()
+        let orderedIndexes = Seq.sort files
+
+        let opening, closing =
+            match boxPos with
+            | First -> "[", "]"
+            | Second -> "(", ")"
+
+        for file in orderedIndexes do
+            let fileName = System.IO.Path.GetFileName(filesInProject[file].FileName)
+            sb.Append($"    {fileName}{opening}{file}{closing}\n") |> ignore
+
+        sb.ToString()
+
+    let printNode (parent: TrieNode, node: TrieNode) =
+        match node.Current with
+        | TrieNodeInfo.Root files ->
+            let firstBox = toBoxList First files
+
+            if System.String.IsNullOrWhiteSpace firstBox then
+                appendLine "class root\n"
+            else
+                appendLine $"class root {{\n{firstBox}}}\n"
+        | TrieNodeInfo.Module (_name, file) as md ->
+            let name = getName md
+            let fileName = System.IO.Path.GetFileName(filesInProject[file].FileName)
+            appendLine $"{getName parent.Current} <|-- {name}"
+            appendLine $"class {name} {{\n    {fileName}[{file}]\n}}\n"
+        | TrieNodeInfo.Namespace (_name, filesThatExposeTypes, filesDefiningNamespaceWithoutTypes) as ns ->
+            let name = getName ns
+            let firstBox = toBoxList First filesThatExposeTypes
+            let secondBox = toBoxList Second filesDefiningNamespaceWithoutTypes
+            appendLine $"{getName parent.Current} <|-- {name}"
+
+            if
+                System.String.IsNullOrWhiteSpace(firstBox)
+                && System.String.IsNullOrWhiteSpace(secondBox)
+            then
+                appendLine $"class {name}"
+            else
+                appendLine $"class {name} {{\n{firstBox}\n{secondBox}}}\n"
+
+    let rec traverse (v: TrieNode) =
+        discovered.Add(v.Current) |> ignore
+
+        for c in v.Children do
+            if not (discovered.Contains(c.Value.Current)) then
+                printNode (v, c.Value)
+                traverse c.Value
+
+    appendLine "```mermaid"
+    appendLine "classDiagram\n"
+
+    printNode (trie, trie)
+    traverse trie
+
+    appendLine "```"
+
+    use out =
+        FileSystem.OpenFileForWriteShim(path, fileMode = System.IO.FileMode.Create)
+
+    out.WriteAllText(sb.ToString())

src/Compiler/Driver/GraphChecking/TrieMapping.fsi

@@ -3,3 +3,5 @@ module internal FSharp.Compiler.GraphChecking.TrieMapping
 /// Process all the files (in parallel) in a project to construct a Root TrieNode.
 /// When the project has signature files, the implementation counterparts will not be processed.
 val mkTrie: files: FileInProject array -> TrieNode
+
+val serializeToMermaid: path: string -> filesInProject: FileInProject array -> trie: TrieNode -> unit

src/Compiler/Driver/ParseAndCheckInputs.fs

@@ -1627,7 +1627,7 @@ let CheckMultipleInputsUsingGraphMode
 
     let filePairs = FilePairMap(sourceFiles)
 
-    let graph =
+    let graph, trie =
         DependencyResolution.mkGraph tcConfig.compilingFSharpCore filePairs sourceFiles
 
     let nodeGraph =
@@ -1674,6 +1674,9 @@ let CheckMultipleInputsUsingGraphMode
             let outputFile = FileSystem.GetFullPathShim(outputFile)
             let graphFile = FileSystem.ChangeExtensionShim(outputFile, ".graph.md")
 
+            let trieFile = FileSystem.ChangeExtensionShim(outputFile, ".trie.md")
+            TrieMapping.serializeToMermaid trieFile sourceFiles trie
+
             graph
             |> Graph.map (fun idx ->
                 let friendlyFileName =

tests/FSharp.Compiler.ComponentTests/TypeChecks/Graph/DependencyResolutionTests.fs

@@ -11,7 +11,7 @@ let scenarios = codebases
 let ``Supported scenario`` (scenario: Scenario) =
     let files = scenario.Files |> Array.map (fun f -> TestFileWithAST.Map f.FileWithAST) 
     let filePairs = FilePairMap(files)
-    let graph = DependencyResolution.mkGraph false filePairs files
+    let graph, _trie = DependencyResolution.mkGraph false filePairs files
 
     for file in scenario.Files do
         let expectedDeps = file.ExpectedDependencies

tests/FSharp.Compiler.ComponentTests/TypeChecks/Graph/TypedTreeGraph.fs

@@ -156,7 +156,7 @@ let ``Create Graph from typed tree`` (projectArgumentsFilePath: string) =
 
             let filePairs = files.Values |> Seq.map TestFileWithAST.Map |> Seq.toArray |> FilePairMap
 
-            let graphFromHeuristic =
+            let graphFromHeuristic, _trie =
                 let isFSharpCore = Path.GetFileNameWithoutExtension(projectArgumentsFilePath).StartsWith("FSharp.Core")
                 files.Values |> Seq.map TestFileWithAST.Map |> Seq.toArray |> DependencyResolution.mkGraph isFSharpCore filePairs