Use file names in printing top level module names

Close #191.
Close fsprojects-archive/zzarchive-VisualFSharpPowerTools#1356.

src/Fantomas.Tests/TestHelpers.fs

@@ -38,7 +38,7 @@ let sharedChecker = lazy(FSharpChecker.Create())
 let formatSourceString isFsiFile (s : string) config = 
     // On Linux/Mac this will exercise different line endings
     let s = s.Replace("\r\n", Environment.NewLine)
-    let fileName = if isFsiFile then "/tmp.fsi" else "/tmp.fsx"
+    let fileName = if isFsiFile then "/src.fsi" else "/src.fsx"
     CodeFormatter.FormatDocumentAsync(fileName, s, config, projectOptions fileName, sharedChecker.Value)
     |> Async.RunSynchronously
     |> fun s -> s.Replace("\r\n", "\n")
@@ -75,10 +75,10 @@ let parse isFsiFile s =
     |> Async.RunSynchronously
 
 let formatAST a s c =
-    CodeFormatter.FormatAST(a, s, c)
+    CodeFormatter.FormatAST(a, "/tmp.fsx",s, c)
 
 let makeRange l1 c1 l2 c2 = 
-    CodeFormatter.MakeRange(l1, c1, l2, c2)
+    CodeFormatter.MakeRange("/tmp.fsx", l1, c1, l2, c2)
 
 let makePos l1 c1 = 
     CodeFormatter.MakePos(l1, c1)

src/Fantomas/CodeFormatter.fs

@@ -35,8 +35,8 @@ type CodeFormatter =
         CodeFormatterImpl.createFormatContext fileName source projectOptions checker
         |> CodeFormatterImpl.formatSelectionInDocument selection config
 
-    static member FormatAST(ast, source, config) = 
-        CodeFormatterImpl.formatAST ast source config
+    static member FormatAST(ast, fileName, source, config) = 
+        CodeFormatterImpl.formatAST ast fileName source config
 
     static member ParseAsync(fileName, source, projectOptions, checker) = 
         CodeFormatterImpl.createFormatContext fileName source projectOptions checker
@@ -62,8 +62,8 @@ type CodeFormatter =
     static member MakePos(line, col) = 
         CodeFormatterImpl.makePos line col
 
-    static member MakeRange(startLine, startCol, endLine, endCol) = 
-        CodeFormatterImpl.makeRange startLine startCol endLine endCol
+    static member MakeRange(fileName, startLine, startCol, endLine, endCol) = 
+        CodeFormatterImpl.makeRange fileName startLine startCol endLine endCol
 
 [<CompilationRepresentation(CompilationRepresentationFlags.ModuleSuffix)>]
 module CodeFormatter =
@@ -90,10 +90,10 @@ module CodeFormatter =
         |> Async.RunSynchronously
 
     let formatAST ast sourceCode config = 
-        CodeFormatterImpl.formatAST ast sourceCode config
+        CodeFormatterImpl.formatAST ast "/tmp.fsx" sourceCode config
 
     let makeRange startLine startCol endLine endCol = 
-        CodeFormatterImpl.makeRange startLine startCol endLine endCol
+        CodeFormatterImpl.makeRange "/tmp.fsx" startLine startCol endLine endCol
 
     let formatSelectionOnly isFsiFile (range : range) (sourceCode : string) config =
         createFormatContextNoFileName isFsiFile sourceCode

src/Fantomas/CodeFormatter.fsi

@@ -13,7 +13,7 @@ type CodeFormatter =
     /// Parse a source string using given config
     static member ParseAsync : fileName:string * source:string * projectOptions:FSharpProjectOptions * checker:FSharpChecker -> Async<ParsedInput> 
     /// Format an abstract syntax tree using an optional source for looking up literals
-    static member FormatAST : ast:ParsedInput * source:string option * config:FormatConfig -> string
+    static member FormatAST : ast:ParsedInput * fileName:string * source:string option * config:FormatConfig -> string
     
     /// Infer selection around cursor by looking for a pair of '[' and ']', '{' and '}' or '(' and ')'. 
     static member InferSelectionFromCursorPos : fileName:string * cursorPos:pos * source:string -> range
@@ -54,7 +54,7 @@ type CodeFormatter =
     static member IsValidFSharpCodeAsync : fileName:string * source:string * projectOptions:FSharpProjectOptions * checker:FSharpChecker -> Async<bool>
     
     static member MakePos : line:int * col:int -> pos
-    static member MakeRange : startLine:int * startCol:int * endLine:int * endCol:int -> range
+    static member MakeRange : fileName:string * startLine:int * startCol:int * endLine:int * endCol:int -> range
 
 [<CompilationRepresentation(CompilationRepresentationFlags.ModuleSuffix)>]
 module CodeFormatter =

src/Fantomas/CodeFormatter.fsx

@@ -25,6 +25,7 @@ fsi.AddPrinter (fun (p : pos) -> p.ToString())
 fsi.AddPrinter (fun (r : range) -> r.ToString())
 
 let input = """
+module Tmp
 let f (arg : 'T) = (^T : (member Value : string) arg)
 """
 

src/Fantomas/CodeFormatterImpl.fs

@@ -340,14 +340,14 @@ let isValidFSharpCode formatContext =
             return false
     }
 
-let formatWith ast input config =
+let formatWith ast moduleName input config =
     // Use '\n' as the new line delimiter consistently
     // It would be easier for F# parser
     let sourceCode = defaultArg input String.Empty
     let normalizedSourceCode = String.normalizeNewLine sourceCode
     let formattedSourceCode =
         Context.create config normalizedSourceCode 
-        |> genParsedInput ASTContext.Default ast
+        |> genParsedInput { ASTContext.Default with TopLevelModuleName = moduleName } ast
         |> dump
         |> if config.StrictMode then id else integrateComments normalizedSourceCode
 
@@ -356,10 +356,10 @@ let formatWith ast input config =
         raise <| FormatException "Incomplete code fragment which is most likely due to parsing errors or the use of F# constructs newer than supported."
     else formattedSourceCode
 
-let format config ({ Source = sourceCode } as formatContext) =
+let format config ({ Source = sourceCode; FileName =  filePath } as formatContext) =
     async {
         let! ast = parse formatContext
-        return formatWith ast (Some sourceCode) config
+        return formatWith ast (Path.GetFileNameWithoutExtension filePath) (Some sourceCode) config
     }
 
 /// Format a source string using given config
@@ -375,8 +375,8 @@ let formatDocument config formatContext =
     }
 
 /// Format an abstract syntax tree using given config
-let formatAST ast sourceCode config =
-    let formattedSourceCode = formatWith ast sourceCode config
+let formatAST ast fileName sourceCode config =
+    let formattedSourceCode = formatWith ast fileName sourceCode config
 
     // When formatting the whole document, an EOL is required
     if formattedSourceCode.EndsWith(Environment.NewLine) then 
@@ -385,8 +385,8 @@ let formatAST ast sourceCode config =
         formattedSourceCode + Environment.NewLine
 
 /// Make a range from (startLine, startCol) to (endLine, endCol) to select some text
-let makeRange startLine startCol endLine endCol =
-    mkRange "/tmp.fsx" (mkPos startLine startCol) (mkPos endLine endCol)
+let makeRange fileName startLine startCol endLine endCol =
+    mkRange fileName (mkPos startLine startCol) (mkPos endLine endCol)
 
 /// Get first non-whitespace line
 let rec getStartLineIndex (lines : _ []) i =
@@ -562,7 +562,7 @@ let formatRange returnFormattedContentOnly (range : range) (lines : _ []) config
 
 /// Format a part of source string using given config, and return the (formatted) selected part only.
 /// Beware that the range argument is inclusive. If the range has a trailing newline, it will appear in the formatted result.
-let formatSelection (range : range) config ({ Source = sourceCode } as formatContext) =
+let formatSelection (range : range) config ({ Source = sourceCode; FileName =  fileName } as formatContext) =
     let lines = String.normalizeThenSplitNewLine sourceCode
 
     // Move to the section with real contents
@@ -579,7 +579,7 @@ let formatSelection (range : range) config ({ Source = sourceCode } as formatCon
                     min range.EndColumn (lines.[endLine-1].Length - 1) 
                 else lines.[endLine-1].Length - 1
             // Notice that Line indices start at 1 while Column indices start at 0.
-            makeRange startLine startCol endLine endCol
+            makeRange fileName startLine startCol endLine endCol
 
     let startCol =
         let line = lines.[contentRange.StartLine-1].[contentRange.StartColumn..]
@@ -589,7 +589,7 @@ let formatSelection (range : range) config ({ Source = sourceCode } as formatCon
         let line = lines.[contentRange.EndLine-1].[..contentRange.EndColumn]
         contentRange.EndColumn - line.Length + line.TrimEnd().Length
 
-    let modifiedRange = makeRange range.StartLine startCol range.EndLine endCol
+    let modifiedRange = makeRange fileName range.StartLine startCol range.EndLine endCol
     Debug.WriteLine("Original range: {0} --> content range: {1} --> modified range: {2}", 
         sprintf "%O" range, sprintf "%O" contentRange, sprintf "%O" modifiedRange)
 
@@ -623,7 +623,7 @@ let formatSelectionExpanded (range : range) config ({ FileName = fileName; Sourc
             let startCol = 0
             let endCol = lines.[endLine-1].Length - 1
             // Notice that Line indices start at 1 while Column indices start at 0.
-            makeRange startLine startCol endLine endCol
+            makeRange fileName startLine startCol endLine endCol
 
     let startTokenizer = sourceTokenizer.CreateLineTokenizer(lines.[contentRange.StartLine-1])
 
@@ -635,7 +635,7 @@ let formatSelectionExpanded (range : range) config ({ FileName = fileName; Sourc
 
     let endCol = getEndCol contentRange endTokenizer (ref 0L)
 
-    let expandedRange = makeRange contentRange.StartLine startCol contentRange.EndLine endCol
+    let expandedRange = makeRange fileName contentRange.StartLine startCol contentRange.EndLine endCol
     async {
         let! result = formatRange false expandedRange lines config formatContext
         return (result, expandedRange)
@@ -773,7 +773,7 @@ let inferSelectionFromCursorPos (cursorPos : pos) fileName (sourceCode : string)
         | None ->
             raise <| FormatException("""Found no pair of delimiters (e.g. "[ ]", "[| |]", "{ }" or "( )") around the cursor.""")
         | Some (startLine, startCol) ->
-            makeRange startLine startCol endLine endCol
+            makeRange fileName startLine startCol endLine endCol
 
 /// Format around cursor delimited by '[' and ']', '{' and '}' or '(' and ')' using given config; keep other parts unchanged. 
 let formatAroundCursor (cursorPos : pos) config ({ FileName = fileName; Source = sourceCode } as formatContext) = 

src/Fantomas/CodePrinter.fs

@@ -11,7 +11,9 @@ open Fantomas.SourceTransformer
 
 /// This type consists of contextual information which is important for formatting
 type ASTContext =
-    { 
+    {
+      /// Original file name without extension of the parsed AST 
+      TopLevelModuleName: string 
       /// Current node is the first child of its parent
       IsFirstChild: bool
       /// Current node is a subnode deep down in an interface
@@ -30,7 +32,8 @@ type ASTContext =
       IsInsideDotGet: bool
     }
     static member Default =
-        { IsFirstChild = false; IsInterface = false 
+        { TopLevelModuleName = "" 
+          IsFirstChild = false; IsInterface = false 
           IsCStylePattern = false; IsNakedRange = false
           HasVerticalBar = false; IsUnionField = false
           IsFirstTypeParam = false; IsInsideDotGet = false }
@@ -79,15 +82,16 @@ and genParsedHashDirective (ParsedHashDirective(h, s)) =
 and genModuleOrNamespace astContext (ModuleOrNamespace(ats, px, ao, s, mds, isModule)) =
     genPreXmlDoc px
     +> genAttributes astContext ats
-    // Checking for Tmp is a bit fragile
-    +> ifElse (s = "Tmp") sepNone (ifElse isModule (!- "module ") (!- "namespace ")
+    +> ifElse (String.Equals(s, astContext.TopLevelModuleName, StringComparison.InvariantCultureIgnoreCase)) sepNone 
+         (ifElse isModule (!- "module ") (!- "namespace ")
             +> opt sepSpace ao genAccess +> ifElse (s = "") (!- "global") (!- s) +> rep 2 sepNln)
     +> genModuleDeclList astContext mds
 
 and genSigModuleOrNamespace astContext (SigModuleOrNamespace(ats, px, ao, s, mds, isModule)) =
     genPreXmlDoc px
     +> genAttributes astContext ats
-    +> ifElse (s = "Tmp") sepNone (ifElse isModule (!- "module ") (!- "namespace ")
+    +> ifElse (String.Equals(s, astContext.TopLevelModuleName, StringComparison.InvariantCultureIgnoreCase)) sepNone 
+          (ifElse isModule (!- "module ") (!- "namespace ")
     +> opt sepSpace ao genAccess -- s +> rep 2 sepNln)
     +> genSigModuleDeclList astContext mds