Merge DesugaredLambda and Lambda to one active pattern. Fixes #1631. (#…

…1633)
fsprojects · Apr 11, 2021 · 03d7a32 · 03d7a32
1 parent a926fe8
commit 03d7a32
Show file tree

Hide file tree

Showing 5 changed files with 63 additions and 143 deletions.
diff --git a/src/Fantomas.Tests/LambdaTests.fs b/src/Fantomas.Tests/LambdaTests.fs
@@ -171,7 +171,7 @@ List.filter (fun ({ ContentBefore = contentBefore }) ->
         equal
         """
 List.filter
-    (fun { ContentBefore = contentBefore } ->
+    (fun ({ ContentBefore = contentBefore }) ->
         // some comment
         let a = 8
         let b = List.length contentBefore
@@ -196,7 +196,7 @@ let a =
         equal
         """
 let a =
-    (fun { ContentBefore = contentBefore } ->
+    (fun ({ ContentBefore = contentBefore }) ->
         // some comment
         let a = 8
         let b = List.length contentBefore
@@ -801,3 +801,34 @@ fun x -> x * 42)
 
 ( (* comment on first line is OK too *) fun x -> x * 42)
 """
+
+[<Test>]
+let ``desugared union case, 1631`` () =
+    formatSourceString
+        false
+        """
+      col
+                        (fun (ArgInfo (ats, so, isOpt), t) -> sepNone)
+"""
+        config
+    |> prepend newline
+    |> should
+        equal
+        """
+col (fun (ArgInfo (ats, so, isOpt), t) -> sepNone)
+"""
+
+[<Test>]
+let ``two wild args`` () =
+    formatSourceString
+        false
+        """
+fun _ _ -> ()
+"""
+        config
+    |> prepend newline
+    |> should
+        equal
+        """
+fun _ _ -> ()
+"""
diff --git a/src/Fantomas.Tests/MultiLineLambdaClosingNewlineTests.fs b/src/Fantomas.Tests/MultiLineLambdaClosingNewlineTests.fs
@@ -202,7 +202,7 @@ let myTopLevelFunction v =
             let meh = "foo"
             a
         )
-        (fun { B = b } ->
+        (fun ({ B = b }) ->
             // probably wrong
             42
         )

diff --git a/src/Fantomas.Tests/StructTests.fs b/src/Fantomas.Tests/StructTests.fs
@@ -95,7 +95,7 @@ match t with
         """
 type S = S of struct (int * int)
 let g : struct (int * int) = struct (1, 1)
-let z = fun ((S (struct (u, v))): S) -> u + v
+let z = fun (S (struct (u, v)): S) -> u + v
 let t = struct (1, 2)
 
 match t with

diff --git a/src/Fantomas/CodePrinter.fs b/src/Fantomas/CodePrinter.fs
@@ -1517,44 +1517,18 @@ and genExpr astContext synExpr ctx =
         | JoinIn (e1, e2) ->
             genExpr astContext e1 -- " in "
             +> genExpr astContext e2
-        | Paren (lpr, DesugaredLambda (cps, e), rpr, pr) ->
+        | Paren (lpr, Lambda (pats, expr, lambdaRange), rpr, pr) ->
             fun (ctx: Context) ->
                 let arrowRange =
-                    List.last cps
-                    |> snd
-                    |> fun lastPatRange -> ctx.MkRange lastPatRange.End e.Range.Start
+                    List.last pats
+                    |> fun lastPat -> ctx.MkRange lastPat.Range.End expr.Range.Start
 
                 let hasLineCommentAfterArrow =
                     findTriviaTokenFromName RARROW arrowRange ctx
                     |> Option.isSome
 
-                let body = genExprKeepIndentInBranch astContext e
-
-                let expr =
-                    sepOpenTFor lpr -- "fun "
-                    +> col sepSpace cps (fst >> genComplexPats astContext)
-                    +> indent
-                    +> triviaAfterArrow arrowRange
-                    +> ifElse
-                        hasLineCommentAfterArrow
-                        (body +> sepCloseTFor rpr pr)
-                        (autoNlnIfExpressionExceedsPageWidth (body +> sepCloseTFor rpr pr))
-                    +> unindent
-
-                expr ctx
-
-        | DesugaredLambda (cps, e) ->
-            !- "fun "
-            +> col sepSpace cps (fst >> genComplexPats astContext)
-            +> sepArrow
-            +> autoIndentAndNlnIfExpressionExceedsPageWidth (genExpr astContext e)
-        | Paren (lpr, Lambda (e, sps, lambdaRange), rpr, pr) ->
-            fun (ctx: Context) ->
-                let hasLineCommentAfterArrow =
-                    findTriviaTokenFromName RARROW synExpr.Range ctx
-                    |> Option.isSome
-
-                let body = genExprKeepIndentInBranch astContext e
+                let body =
+                    genExprKeepIndentInBranch astContext expr
 
                 let expr =
                     let triviaOfLambda f (ctx: Context) =
@@ -1566,9 +1540,9 @@ and genExpr astContext synExpr ctx =
                     sepOpenTFor lpr
                     +> triviaOfLambda printContentBefore
                     -- "fun "
-                    +> col sepSpace sps (genSimplePats astContext)
+                    +> col sepSpace pats (genPat astContext)
                     +> indent
-                    +> triviaAfterArrow synExpr.Range
+                    +> triviaAfterArrow arrowRange
                     +> ifElse
                         hasLineCommentAfterArrow
                         (body +> sepCloseTFor rpr pr)
@@ -1578,12 +1552,12 @@ and genExpr astContext synExpr ctx =
                 expr ctx
 
         // When there are parentheses, most likely lambda will appear in function application
-        | Lambda (e, sps, _) ->
+        | Lambda (pats, expr, _range) ->
             atCurrentColumn (
                 !- "fun "
-                +> col sepSpace sps (genSimplePats astContext)
+                +> col sepSpace pats (genPat astContext)
                 +> sepArrow
-                +> autoIndentAndNlnIfExpressionExceedsPageWidth (genExpr astContext e)
+                +> autoIndentAndNlnIfExpressionExceedsPageWidth (genExpr astContext expr)
             )
         | MatchLambda (cs, _) ->
             !- "function "
@@ -3267,19 +3241,12 @@ and genApp astContext e es ctx =
                             |> genTriviaFor SynExpr_Paren pr
 
                         match e with
-                        | Paren (lpr, DesugaredLambda (cps, e), rpr, pr) ->
-                            let arrowRange =
-                                List.last cps
-                                |> snd
-                                |> fun lastPatRange -> ctx.MkRange lastPatRange.End e.Range.Start
-
-                            genLambda (col sepSpace cps (fst >> genComplexPats astContext)) e lpr rpr arrowRange pr
-                        | Paren (lpr, Lambda (e, sps, _), rpr, pr) ->
+                        | Paren (lpr, Lambda (pats, expr, _range), rpr, pr) ->
                             let arrowRange =
-                                List.last sps
-                                |> fun sp -> ctx.MkRange sp.Range.End e.Range.Start
+                                List.last pats
+                                |> fun lastPat -> ctx.MkRange lastPat.Range.End expr.Range.Start
 
-                            genLambda (col sepSpace sps (genSimplePats astContext)) e lpr rpr arrowRange pr
+                            genLambda (col sepSpace pats (genPat astContext)) expr lpr rpr arrowRange pr
                         | _ -> genExpr astContext e)
 
             let singleLambdaArgument =
@@ -3308,19 +3275,12 @@ and genApp astContext e es ctx =
                             +> sepCloseTFor rpr
 
                         match e with
-                        | Paren (lpr, DesugaredLambda (cps, e), rpr, _) ->
-                            let arrowRange =
-                                List.last cps
-                                |> snd
-                                |> fun lastPatRange -> ctx.MkRange lastPatRange.End e.Range.Start
-
-                            genLambda (col sepSpace cps (fst >> genComplexPats astContext)) e lpr rpr arrowRange
-                        | Paren (lpr, Lambda (e, sps, _), rpr, _) ->
+                        | Paren (lpr, Lambda (pats, expr, _range), rpr, _) ->
                             let arrowRange =
-                                List.last sps
-                                |> fun sp -> ctx.MkRange sp.Range.End e.Range.Start
+                                List.last pats
+                                |> fun lastPat -> ctx.MkRange lastPat.Range.End expr.Range.Start
 
-                            genLambda (col sepSpace sps (genSimplePats astContext)) e lpr rpr arrowRange
+                            genLambda (col sepSpace pats (genPat astContext)) expr lpr rpr arrowRange
                         | _ -> genExpr astContext e)
 
             let argExpr =
@@ -4732,31 +4692,6 @@ and genSimplePats astContext node =
         +> sepColon
         +> genType astContext false t
 
-and genComplexPat astContext node =
-    match node with
-    | CPId p -> genPat astContext p
-    | CPSimpleId (s, isOptArg, _) -> ifElse isOptArg (!-(sprintf "?%s" s)) (!-s)
-    | CPTyped (sp, t) ->
-        genComplexPat astContext sp
-        +> sepColon
-        +> genType astContext false t
-    | CPAttrib (ats, sp) ->
-        genOnelinerAttributes astContext ats
-        +> genComplexPat astContext sp
-
-and genComplexPats astContext node =
-    match node with
-    | ComplexPats [ CPId _ as c ]
-    | ComplexPats [ CPSimpleId _ as c ] -> genComplexPat astContext c
-    | ComplexPats ps ->
-        sepOpenT
-        +> col sepComma ps (genComplexPat astContext)
-        +> sepCloseT
-    | ComplexTyped (ps, t) ->
-        genComplexPats astContext ps
-        +> sepColon
-        +> genType astContext false t
-
 and genPatRecordFieldName astContext (PatRecordFieldName (s1, s2, p)) =
     ifElse (s1 = "") (!-(sprintf "%s = " s2)) (!-(sprintf "%s.%s = " s1 s2))
     +> genPat

diff --git a/src/Fantomas/SourceParser.fs b/src/Fantomas/SourceParser.fs
@@ -845,13 +845,6 @@ let (|TernaryApp|_|) =
     | SynExpr.App (_, _, SynExpr.App (_, _, SynExpr.App (_, true, Var "?<-", e1, _), e2, _), e3, _) -> Some(e1, e2, e3)
     | _ -> None
 
-/// Gather all arguments in lambda
-let rec (|Lambda|_|) =
-    function
-    | SynExpr.Lambda (_, _, pats, Lambda (e, patss, _), _, range) -> Some(e, (pats :: patss), range)
-    | SynExpr.Lambda (_, _, pats, e, _, range) -> Some(e, [ pats ], range)
-    | _ -> None
-
 let (|MatchLambda|_|) =
     function
     | SynExpr.MatchLambda (isMember, _, pats, _, _) -> Some(pats, isMember)
@@ -1219,57 +1212,18 @@ let (|RecordField|) =
 
 let (|Clause|) (SynMatchClause.Clause (p, eo, e, _, _)) = (p, e, eo)
 
-let rec private (|DesugaredMatch|_|) =
-    function
-    | SynExpr.Match (_, CompilerGeneratedVar s, [ Clause (p, DesugaredMatch (ss, e), None) ], _) ->
-        Some((s, p) :: ss, e)
-    | SynExpr.Match (_, CompilerGeneratedVar s, [ Clause (p, e, None) ], _) -> Some([ (s, p) ], e)
-    | _ -> None
-
-type ComplexPat =
-    | CPAttrib of SynAttributes * ComplexPat
-    | CPId of SynPat
-    | CPSimpleId of string * bool * bool
-    | CPTyped of ComplexPat * SynType
-
-type ComplexPats =
-    | ComplexPats of ComplexPat list
-    | ComplexTyped of ComplexPats * SynType
-
-/// Manipulate patterns in case the compiler generate spurious matches
-let rec transformPatterns ss =
-    function
-    | SimplePats sps ->
-        let rec loop sp =
-            match sp with
-            | SPAttrib (ats, sp) -> CPAttrib(ats, loop sp)
-            | SPId (s, b, true) ->
-                match List.tryPick (fun (s', p) -> if s = s' then Some p else None) ss with
-                | Some p ->
-                    match p with
-                    | PatConst _
-                    | PatQuoteExpr _
-                    | PatNullary _
-                    | PatRecord _
-                    | PatSeq ((PatList
-                              | PatArray),
-                              _) ->
-                        // A few patterns with delimiters
-                        CPId p
-                    | _ ->
-                        // Add parentheses to separate from other patterns
-                        CPId(SynPat.Paren(p, p.Range))
-                | None -> CPSimpleId(s, b, true)
-            | SPId (s, b, _) -> CPSimpleId(s, b, false)
-            | SPTyped (sp, t) -> CPTyped(loop sp, t)
-
-        List.map loop sps |> ComplexPats
-    | SPSTyped (sp, t) -> ComplexTyped(transformPatterns ss sp, t)
-
 /// Process compiler-generated matches in an appropriate way
-let (|DesugaredLambda|_|) =
+let (|Lambda|_|) =
     function
-    | Lambda (DesugaredMatch (ss, e), spss, _) -> Some(List.map (fun sp -> transformPatterns ss sp, sp.Range) spss, e)
+    | SynExpr.Lambda (_, _, _, _, Some (pats, body), range) ->
+        // find the body expression from the last lambda
+        let rec visit (e: SynExpr) : SynExpr =
+            match e with
+            | SynExpr.Match (matchSeqPoint = NoDebugPointAtInvisibleBinding; clauses = [ Clause (_, expr, _) ])
+            | SynExpr.Lambda (_, _, _, SynExpr.Match(clauses = [ Clause (_, expr, _) ]), _, _) -> visit expr
+            | _ -> e
+
+        Some(pats, visit body, range)
     | _ -> None
 
 // Type definitions