Put arrow on next line if when expression is multiline. Fixes #1545. (#…

…1547)

src/Fantomas.Tests/MultilineFunctionApplicationsInConditionExpressionsTests.fs

@@ -98,7 +98,8 @@ module ElectrumClient =
                         PROTOCOL_VERSION_SUPPORTED
                 with :? ElectrumServerReturningErrorException as except when
                     except.Message.EndsWith
-                        (PROTOCOL_VERSION_SUPPORTED.ToString()) ->
+                        (PROTOCOL_VERSION_SUPPORTED.ToString())
+                    ->
 
                     failwith "xxx"
 

src/Fantomas.Tests/PatternMatchingTests.fs

@@ -1088,7 +1088,8 @@ module Foo =
             match v.IsMember, v.IsInstanceMember, v.LogicalName, v.DisplayName with
             // Ordinary functions or values
             | false, _, _, name when
-                not (hasAttribute<RequireQualifiedAccessAttribute> v.ApparentEnclosingEntity.Attributes) ->
+                not (hasAttribute<RequireQualifiedAccessAttribute> v.ApparentEnclosingEntity.Attributes)
+                ->
                 name + " " + parArgs
             // Ordinary static members or things (?) that require fully qualified access
             | _, _, _, name -> name + parArgs
@@ -1118,7 +1119,8 @@ let ``maintain indent if when condition is multiline`` () =
 match foo with
 | headToken :: rest when
     (isOperatorOrKeyword headToken
-     && List.exists (fun k -> headToken.TokenInfo.TokenName = k) keywordTrivia) ->
+     && List.exists (fun k -> headToken.TokenInfo.TokenName = k) keywordTrivia)
+    ->
     let range =
         getRangeBetween "keyword" headToken headToken
 
@@ -1599,3 +1601,76 @@ match x with
      "")
 |||> Some
 """
+
+[<Test>]
+let ``pattern match inside when expression, 1545`` () =
+    formatSourceString
+        false
+        """
+let GenApp (cenv: cenv) cgbuf eenv (f, fty, tyargs, curriedArgs, m) sequel =
+  let g = cenv.g
+  match (f, tyargs, curriedArgs) with
+  // Look for tailcall to turn into branch
+  | (Expr.Val (v, _, _), _, _) when
+        match ListAssoc.tryFind g.valRefEq v eenv.innerVals with
+        | Some (kind, _) ->
+           (not v.IsConstructor &&
+            // when branch-calling methods we must have the right type parameters
+            (match kind with
+             | BranchCallClosure _ -> true
+             | BranchCallMethod (_, _, tps, _, _, _) ->
+                  (List.lengthsEqAndForall2 (fun ty tp -> typeEquiv g ty (mkTyparTy tp)) tyargs tps)) &&
+            // must be exact #args, ignoring tupling - we untuple if needed below
+            (let arityInfo =
+               match kind with
+               | BranchCallClosure arityInfo
+               | BranchCallMethod (arityInfo, _, _, _, _, _)  -> arityInfo
+             arityInfo.Length = curriedArgs.Length
+            ) &&
+            (* no tailcall out of exception handler, etc. *)
+            (match sequelIgnoringEndScopesAndDiscard sequel with Return | ReturnVoid -> true | _ -> false))
+        | None -> false
+    ->
+        let (kind, mark) = ListAssoc.find g.valRefEq v eenv.innerVals // already checked above in when guard
+        ()
+"""
+        config
+    |> prepend newline
+    |> should
+        equal
+        """
+let GenApp (cenv: cenv) cgbuf eenv (f, fty, tyargs, curriedArgs, m) sequel =
+    let g = cenv.g
+
+    match (f, tyargs, curriedArgs) with
+    // Look for tailcall to turn into branch
+    | (Expr.Val (v, _, _), _, _) when
+        match ListAssoc.tryFind g.valRefEq v eenv.innerVals with
+        | Some (kind, _) ->
+            (not v.IsConstructor
+             &&
+             // when branch-calling methods we must have the right type parameters
+             (match kind with
+              | BranchCallClosure _ -> true
+              | BranchCallMethod (_, _, tps, _, _, _) ->
+                  (List.lengthsEqAndForall2 (fun ty tp -> typeEquiv g ty (mkTyparTy tp)) tyargs tps))
+             &&
+             // must be exact #args, ignoring tupling - we untuple if needed below
+             (let arityInfo =
+                 match kind with
+                 | BranchCallClosure arityInfo
+                 | BranchCallMethod (arityInfo, _, _, _, _, _) -> arityInfo
+
+              arityInfo.Length = curriedArgs.Length)
+             && (* no tailcall out of exception handler, etc. *)
+             (match sequelIgnoringEndScopesAndDiscard sequel with
+              | Return
+              | ReturnVoid -> true
+              | _ -> false))
+        | None -> false
+        ->
+        let (kind, mark) =
+            ListAssoc.find g.valRefEq v eenv.innerVals // already checked above in when guard
+
+        ()
+"""

src/Fantomas/CodePrinter.fs

@@ -4326,41 +4326,50 @@ and genInterfaceImpl astContext (InterfaceImpl (t, bs, range)) =
 and genClause astContext hasBar (Clause (p, e, eo) as ce) =
     let arrowRange (ctx: Context) = ctx.MkRange p.Range.End e.Range.Start
 
-    let body =
-        autoIndentAndNlnIfExpressionExceedsPageWidth (genExpr astContext e)
-
     let astCtx =
         { astContext with
               IsInsideMatchClausePattern = true }
 
-    let pat =
+    let patAndBody =
         genPat astCtx p
-        +> optPre
-            (!- " when")
-            sepNone
-            eo
-            (fun e ->
-                let short = sepSpace +> genExpr astContext e
+        +> leadingExpressionIsMultiline
+            (optPre
+                (!- " when")
+                sepNone
+                eo
+                (fun e ->
+                    let short = sepSpace +> genExpr astContext e
 
-                let long =
-                    match e with
-                    | AppParenArg app ->
-                        indent
-                        +> sepNln
-                        +> genAlternativeAppWithParenthesis app astContext
-                        +> unindent
-                    | e ->
-                        indent
-                        +> sepNln
-                        +> (genExpr astContext e)
-                        +> unindent
+                    let long =
+                        match e with
+                        | AppParenArg app ->
+                            indent
+                            +> sepNln
+                            +> genAlternativeAppWithParenthesis app astContext
+                            +> unindent
+                        | e ->
+                            indent
+                            +> sepNln
+                            +> (genExpr astContext e)
+                            +> unindent
 
-                expressionFitsOnRestOfLine short long)
-        +> sepArrow
-        +> fun ctx -> leaveNodeTokenByName (arrowRange ctx) RARROW ctx
+                    expressionFitsOnRestOfLine short long))
+            (fun isMultiline ctx ->
+                if isMultiline then
+                    (indent
+                     +> sepNln
+                     +> tokN (arrowRange ctx) RARROW sepArrowFixed
+                     +> sepNln
+                     +> genExpr astContext e
+                     +> unindent)
+                        ctx
+                else
+                    (tokN (arrowRange ctx) RARROW sepArrow
+                     +> autoIndentAndNlnIfExpressionExceedsPageWidth (genExpr astContext e))
+                        ctx)
 
     genTriviaBeforeClausePipe p.Range
-    +> (onlyIf hasBar sepBar +> pat +> body
+    +> (onlyIf hasBar sepBar +> patAndBody
         |> genTriviaFor SynMatchClause_Clause ce.Range)
 
 and genClauses astContext cs =

src/Fantomas/Context.fs

@@ -674,7 +674,7 @@ let internal sepStarFixed = !- "* "
 let internal sepEq = !- " ="
 let internal sepEqFixed = !- "="
 let internal sepArrow = !- " -> "
-let internal sepArrowFixed = !- "-> "
+let internal sepArrowFixed = !- "->"
 let internal sepArrowRev = !- " <- "
 let internal sepWild = !- "_"