Display the fragment count of each defines combination when they diff…

…er in length. Fixes fsprojects#1904.

src/Fantomas.Tests/TestHelpers.fs

@@ -111,7 +111,12 @@ let formatSourceStringWithDefines defines (s: string) config =
         |> Async.RunSynchronously
 
     // merge with itself to make #if go on beginning of line
-    String.merge config.EndOfLine.NewLineString result result
+    let _, fragments =
+        String.splitInFragments config.EndOfLine.NewLineString [ (defines, result) ]
+        |> List.head
+
+    String.merge fragments fragments
+    |> String.concat config.EndOfLine.NewLineString
     |> String.normalizeNewLine
 
 let formatSelectionOnly isFsiFile r (s: string) config =

src/Fantomas.Tests/UtilsTests.fs

@@ -8,7 +8,13 @@ open FsCheck
 
 let private mergeAndCompare a b expected =
     let result =
-        String.merge Environment.NewLine a b
+        let getFragments code =
+            String.splitInFragments config.EndOfLine.NewLineString [ code ]
+            |> List.head
+            |> snd
+
+        String.merge (getFragments a) (getFragments b)
+        |> String.concat Environment.NewLine
         |> String.normalizeNewLine
 
     let normalizedExpected = String.normalizeNewLine expected
@@ -38,7 +44,7 @@ let ``merging of source code that starts with a hash`` () =
     printfn \"foo\"
 #endif
 """
-    |> mergeAndCompare a b
+    |> mergeAndCompare ([], a) ([ "NOT_DEFINED" ], b)
 
 [<Test>]
 let ``merging of defines content work when source code starts with a newline`` () =
@@ -76,7 +82,7 @@ let private assemblyConfig() =
 #endif
     x
 """
-    |> mergeAndCompare a b
+    |> mergeAndCompare ([], a) ([ "TRACE" ], b)
 
 [<Test>]
 let ``only split on control structure keyword`` () =
@@ -112,7 +118,7 @@ SetupTesting.generateSetupScript __SOURCE_DIRECTORY__
 #load "__setup__.fsx"
 #endif
 """
-    |> mergeAndCompare a b
+    |> mergeAndCompare ([], a) ([ "INTERACTIVE" ], b)
 
 [<Test>]
 let ``when input is empty`` () =

src/Fantomas/CodeFormatterImpl.fs

@@ -403,16 +403,51 @@ let format
     async {
         let! asts = parse checker parsingOptions formatContext
 
-        let results =
+        let! results =
             asts
-            |> Array.map (fun (ast', defines, hashTokens) -> formatWith ast' defines hashTokens formatContext config)
-            |> List.ofArray
+            |> Array.map
+                (fun (ast', defines, hashTokens) ->
+                    async {
+                        let formattedCode =
+                            formatWith ast' defines hashTokens formatContext config
+
+                        return (defines, formattedCode)
+                    })
+            |> Async.Parallel
+            |> Async.map Array.toList
 
         let merged =
             match results with
             | [] -> failwith "not possible"
-            | [ x ] -> x
-            | all -> List.reduce (String.merge config.EndOfLine.NewLineString) all
+            | [ (_, x) ] -> x
+            | all ->
+                let allInFragments =
+                    String.splitInFragments config.EndOfLine.NewLineString all
+
+                let allHaveSameFragmentCount =
+                    let allWithCount =
+                        List.map (fun (_, f: string list) -> f.Length) allInFragments
+
+                    (Set allWithCount).Count = 1
+
+                if not allHaveSameFragmentCount then
+                    let chunkReport =
+                        allInFragments
+                        |> List.map
+                            (fun (defines, fragments) ->
+                                sprintf "[%s] has %i fragments" (String.concat ", " defines) fragments.Length)
+                        |> String.concat config.EndOfLine.NewLineString
+
+                    failwithf
+                        """Fantomas is trying to format the input multiple times due to the detect of multiple defines.
+There is a problem with merging all the code back together.
+%s
+Please raise an issue at https://fsprojects.github.io/fantomas-tools/#/fantomas/preview."""
+                        chunkReport
+
+                List.map snd allInFragments
+                |> List.reduce String.merge
+                |> String.concat config.EndOfLine.NewLineString
 
         return merged
     }

src/Fantomas/Utils.fs

@@ -59,17 +59,14 @@ module String =
         loop hashLineIndexesWithStart id
         |> List.map (String.concat newline)
 
-    let merge (newline: string) (a: string) (b: string) : string =
-        let aChunks = splitWhenHash newline a
-        let bChunks = splitWhenHash newline b
-
-        if List.length aChunks <> List.length bChunks then
-            Dbg.print (aChunks, bChunks)
-
-            failwithf
-                """Fantomas is trying to format the input multiple times due to the detect of multiple defines.
-There is a problem with merging all the code back together. Please raise an issue at https://github.com/fsprojects/fantomas/issues."""
-
+    let splitInFragments (newline: string) (items: (string list * string) list) : (string list * string list) list =
+        List.map
+            (fun (defines, code) ->
+                let fragments = splitWhenHash newline code
+                defines, fragments)
+            items
+
+    let merge (aChunks: string list) (bChunks: string list) : string list =
         List.zip aChunks bChunks
         |> List.map
             (fun (a', b') ->
@@ -83,7 +80,7 @@ There is a problem with merging all the code back together. Please raise an issu
                 else
                     b')
 
-        |> String.concat newline
+
 
     let empty = String.Empty