Change style of base constructor calls. (#2555)

nojaf · nojaf · commit c6ae6767bcd8 · 2022-10-13T10:05:02.000+02:00
* Change style of base constructor calls.

* Add changelog entry for 5.1.0-alpha-005.
diff --git a/CHANGELOG.md b/CHANGELOG.md
@@ -1,12 +1,16 @@
 # Changelog
 
-## [Unreleased]
+## [5.1.0-alpha-005] - 2022-10-07
 
 ### Changed
 * Control space in pattern by `fsharp_space_before_lowercase_invocation` and `fsharp_space_before_uppercase_invocation`. [fslang-design/issues/712](https://github.com/fsharp/fslang-design/issues/712)
+* Style of base constructor calls. [fsharp/fslang-design#693](https://github.com/fsharp/fslang-design/issues/693)
+* Style of multiline type annotations/ [fsharp/fslang-design#708](https://github.com/fsharp/fslang-design/issues/708)
 
 ### Fixed
 * Comments in SynArgPats.NamePatPairs are lost. [#2541](https://github.com/fsprojects/fantomas/issues/2541)
+* Vanity alignment used inside base ctor call. [#2111](https://github.com/fsprojects/fantomas/issues/2111)
+* Add line break before start of argument list. [#2335](https://github.com/fsprojects/fantomas/issues/2335)
 
 ## [5.1.0-alpha-004] - 2022-10-07
 
diff --git a/src/Fantomas.Core.Tests/BaseConstructorTests.fs b/src/Fantomas.Core.Tests/BaseConstructorTests.fs
@@ -0,0 +1,68 @@
+module Fantomas.Core.Tests.BaseConstructorTests
+
+open NUnit.Framework
+open FsUnit
+open Fantomas.Core.Tests.TestHelper
+
+[<Test>]
+let ``multiple base constructors in record, 2111`` () =
+    formatSourceString
+        false
+        """
+type UnhandledWebException =
+    inherit Exception
+
+    new(status: WebExceptionStatus, innerException: Exception) =
+        { inherit Exception(SPrintF1
+                                "Backend not prepared for this WebException with Status[%i]"
+                                (int status),
+                            innerException) }
+
+    new(info: SerializationInfo, context: StreamingContext) =
+        { inherit Exception(info, context) }
+"""
+        { config with MaxLineLength = 100 }
+    |> prepend newline
+    |> should
+        equal
+        """
+type UnhandledWebException =
+    inherit Exception
+
+    new(status: WebExceptionStatus, innerException: Exception) =
+        { inherit
+            Exception(
+                SPrintF1 "Backend not prepared for this WebException with Status[%i]" (int status),
+                innerException
+            ) }
+
+    new(info: SerializationInfo, context: StreamingContext) = { inherit Exception(info, context) }
+"""
+
+[<Test>]
+let ``single multiline base constructor, 2335`` () =
+    formatSourceString
+        false
+        """
+type FieldNotFoundException<'T>(obj:'T, field:string, specLink:string) =
+    inherit SwaggerSchemaParseException(
+        sprintf "Object MUST contain field `%s` (See %s for more details).\nObject:%A"
+            field specLink obj)
+"""
+        { config with
+            SpaceBeforeClassConstructor = true
+            MaxLineLength = 90 }
+    |> prepend newline
+    |> should
+        equal
+        """
+type FieldNotFoundException<'T> (obj: 'T, field: string, specLink: string) =
+    inherit
+        SwaggerSchemaParseException (
+            sprintf
+                "Object MUST contain field `%s` (See %s for more details).\nObject:%A"
+                field
+                specLink
+                obj
+        )
+"""
diff --git a/src/Fantomas.Core.Tests/ClassTests.fs b/src/Fantomas.Core.Tests/ClassTests.fs
@@ -954,8 +954,8 @@ type public DerivedExceptionWithLongNaaaaaaaaameException
         originalRequest: string,
         originalResponse: string
     ) =
-    inherit BaseExceptionWithLongNaaaameException
-        (
+    inherit
+        BaseExceptionWithLongNaaaameException(
             message,
             code,
             originalRequest,
@@ -991,8 +991,8 @@ type public DerivedExceptionWithLongNaaaaaaaaameException
         originalRequest: string,
         originalResponse: string
     ) =
-    inherit BaseExceptionWithLongNaaaameException
-        (
+    inherit
+        BaseExceptionWithLongNaaaameException(
             message,
             code,
             originalRequest,
diff --git a/src/Fantomas.Core.Tests/Fantomas.Core.Tests.fsproj b/src/Fantomas.Core.Tests/Fantomas.Core.Tests.fsproj
@@ -119,6 +119,7 @@
     <Compile Include="InterfaceStaticMethodTests.fs" />
     <Compile Include="ExternTests.fs" />
     <Compile Include="TypeAnnotationTests.fs" />
+    <Compile Include="BaseConstructorTests.fs" />
   </ItemGroup>
   <ItemGroup>
     <ProjectReference Include="..\Fantomas.Core\Fantomas.Core.fsproj" />
diff --git a/src/Fantomas.Core.Tests/MultilineBlockBracketsOnSameColumnRecordTests.fs b/src/Fantomas.Core.Tests/MultilineBlockBracketsOnSameColumnRecordTests.fs
@@ -151,13 +151,21 @@ let ``record instance with inherit keyword and no fields`` () =
         """let a =
         { inherit ProjectPropertiesBase<_>(projectTypeGuids, factoryGuid, targetFrameworkIds, dotNetCoreSDK) }
 """
-        config
+        { config with MaxLineLength = 80 }
     |> prepend newline
     |> should
         equal
         """
 let a =
-    { inherit ProjectPropertiesBase<_>(projectTypeGuids, factoryGuid, targetFrameworkIds, dotNetCoreSDK) }
+    {
+        inherit
+            ProjectPropertiesBase<_>(
+                projectTypeGuids,
+                factoryGuid,
+                targetFrameworkIds,
+                dotNetCoreSDK
+            )
+    }
 """
 
 [<Test>]
@@ -177,7 +185,10 @@ let ``type with record instance with inherit keyword`` () =
 type ServerCannotBeResolvedException =
     inherit CommunicationUnsuccessfulException
 
-    new(message) = { inherit CommunicationUnsuccessfulException(message) }
+    new(message) =
+        {
+            inherit CommunicationUnsuccessfulException(message)
+        }
 """
 
 [<Test>]
@@ -1270,3 +1281,42 @@ let ``comment after equals in anonymous record field`` () =
         B
 |}
 """
+
+[<Test>]
+let ``multiple base constructors in record`` () =
+    formatSourceString
+        false
+        """
+type UnhandledWebException =
+    inherit Exception
+
+    new(status: WebExceptionStatus, innerException: Exception) =
+        { inherit Exception(SPrintF1
+                                "Backend not prepared for this WebException with Status[%i]"
+                                (int status),
+                            innerException) }
+
+    new(info: SerializationInfo, context: StreamingContext) =
+        { inherit Exception(info, context) }
+"""
+        { config with MaxLineLength = 100 }
+    |> prepend newline
+    |> should
+        equal
+        """
+type UnhandledWebException =
+    inherit Exception
+
+    new(status : WebExceptionStatus, innerException : Exception) =
+        {
+            inherit
+                Exception(
+                    SPrintF1
+                        "Backend not prepared for this WebException with Status[%i]"
+                        (int status),
+                    innerException
+                )
+        }
+
+    new(info : SerializationInfo, context : StreamingContext) = { inherit Exception(info, context) }
+"""
diff --git a/src/Fantomas.Core/CodePrinter.fs b/src/Fantomas.Core/CodePrinter.fs
@@ -1086,11 +1086,9 @@ and genExpr astContext synExpr ctx =
             let smallRecordExpr =
                 genTriviaFor SynExpr_Record_OpeningBrace openingBrace sepOpenS
                 +> optSingle
-                    (fun (inheritType, inheritExpr) ->
+                    (fun inheritCtor ->
                         !- "inherit "
-                        +> genType astContext inheritType
-                        +> addSpaceBeforeClassConstructor inheritExpr
-                        +> genExpr astContext inheritExpr
+                        +> genInheritConstructor astContext inheritCtor
                         +> onlyIf (List.isNotEmpty xs) sepSemi)
                     inheritOpt
                 +> optSingle (fun e -> genExpr astContext e +> !- " with ") eo
@@ -2503,13 +2501,11 @@ and genMultilineRecordInstance
 
     let expr =
         match inheritOpt with
-        | Some (t, e) ->
+        | Some inheritCtor ->
             genTriviaFor SynExpr_Record_OpeningBrace openingBrace sepOpenS
             +> atCurrentColumn (
                 !- "inherit "
-                +> genType astContext t
-                +> addSpaceBeforeClassConstructor e
-                +> genExpr astContext e
+                +> autoIndentAndNlnIfExpressionExceedsPageWidth (genInheritConstructor astContext inheritCtor)
                 +> onlyIf (List.isNotEmpty xs) sepNln
                 +> fieldsExpr
                 +> genTriviaFor SynExpr_Record_ClosingBrace closingBrace sepCloseS
@@ -2568,22 +2564,16 @@ and genMultilineRecordInstanceAlignBrackets
     let hasFields = List.isNotEmpty xs
 
     match inheritOpt, eo with
-    | Some (inheritType, inheritExpr), None ->
-        genTriviaFor SynExpr_Record_OpeningBrace openingBrace sepOpenS
-        +> ifElse hasFields (indent +> sepNln) sepNone
-        +> !- "inherit "
-        +> genType astContext inheritType
-        +> addSpaceBeforeClassConstructor inheritExpr
-        +> genExpr astContext inheritExpr
-        +> ifElse
-            hasFields
-            (sepNln
-             +> fieldsExpr
-             +> unindent
-             +> sepNln
-             +> genTriviaFor SynExpr_Record_ClosingBrace closingBrace sepCloseSFixed)
-            (sepSpace +> genTriviaFor SynExpr_Record_ClosingBrace closingBrace sepCloseSFixed)
-
+    | Some inheritCtor, None ->
+        genTriviaFor SynExpr_Record_OpeningBrace openingBrace sepOpenSFixed
+        +> indentSepNlnUnindent (
+            !- "inherit "
+            +> autoIndentAndNlnIfExpressionExceedsPageWidth (genInheritConstructor astContext inheritCtor)
+            +> onlyIf hasFields sepNln
+            +> fieldsExpr
+        )
+        +> sepNln
+        +> genTriviaFor SynExpr_Record_ClosingBrace closingBrace sepCloseSFixed
     | None, Some e ->
         genTriviaFor SynExpr_Record_OpeningBrace openingBrace sepOpenS
         +> atCurrentColumnIndent (genExpr astContext e)
@@ -2603,6 +2593,18 @@ and genMultilineRecordInstanceAlignBrackets
          +> ifElseCtx lastWriteEventIsNewline sepNone sepNln
          +> genTriviaFor SynExpr_Record_ClosingBrace closingBrace sepCloseSFixed)
 
+and genInheritConstructor (astContext: ASTContext) (inheritCtor: SynType * SynExpr) =
+    match inheritCtor with
+    | TypeOnlyInheritConstructor t -> genType astContext t
+    | UnitInheritConstructor t -> genType astContext t +> sepSpaceBeforeClassConstructor +> sepOpenT +> sepCloseT
+    | ParenInheritConstructor (t, px) ->
+        genType astContext t
+        +> sepSpaceBeforeClassConstructor
+        +> expressionFitsOnRestOfLine (genExpr astContext px) (genMultilineFunctionApplicationArguments astContext px)
+    | OtherInheritConstructor (t, e) ->
+        genType astContext t
+        +> sepSpaceOrIndentAndNlnIfExpressionExceedsPageWidth (genExpr astContext e)
+
 and genMultilineAnonRecord (isStruct: bool) fields copyInfo (astContext: ASTContext) =
     let recordExpr =
         match copyInfo with
@@ -4222,32 +4224,8 @@ and genMemberDefn astContext node =
     | MDOpen lid -> !- "open " +> genSynLongIdent false lid
     // What is the role of so
     | MDImplicitInherit (t, e, _) ->
-        let genBasecall =
-            let shortExpr = genExpr astContext e
-
-            let longExpr =
-                match e with
-                | Paren (lpr, Tuple (es, tr), rpr, pr) ->
-                    indent
-                    +> sepNln
-                    +> indent
-                    +> sepOpenTFor lpr
-                    +> sepNln
-                    +> (col (sepComma +> sepNln) es (genExpr astContext)
-                        |> genTriviaFor SynExpr_Tuple tr)
-                    +> unindent
-                    +> sepNln
-                    +> unindent
-                    +> sepCloseTFor rpr
-                    |> genTriviaFor SynExpr_Paren pr
-                | _ -> genExpr astContext e
-
-            expressionFitsOnRestOfLine shortExpr longExpr
-
         !- "inherit "
-        +> genType astContext t
-        +> addSpaceBeforeClassConstructor e
-        +> genBasecall
+        +> autoIndentAndNlnIfExpressionExceedsPageWidth (genInheritConstructor astContext (t, e))
 
     | MDInherit (t, _) -> !- "inherit " +> genType astContext t
     | MDValField f -> genField astContext "val " f
diff --git a/src/Fantomas.Core/SourceParser.fs b/src/Fantomas.Core/SourceParser.fs
@@ -1042,10 +1042,25 @@ let rec (|ElIf|_|) =
         Some([ (None, trivia.IfKeyword, trivia.IsElif, e1, trivia.ThenKeyword, e2) ], elseInfo, range)
     | _ -> None
 
+let (|TypeOnlyInheritConstructor|UnitInheritConstructor|ParenInheritConstructor|OtherInheritConstructor|)
+    (
+        t: SynType,
+        e: SynExpr
+    ) =
+    match e with
+    | SynExpr.Const (constant = SynConst.Unit; range = unitRange) ->
+        // The unit expression could have been added artificially.
+        if unitRange.StartColumn + 2 = unitRange.EndColumn then
+            UnitInheritConstructor(t)
+        else
+            TypeOnlyInheritConstructor t
+    | SynExpr.Paren _ as px -> ParenInheritConstructor(t, px)
+    | _ -> OtherInheritConstructor(t, e)
+
 let (|Record|_|) =
     function
     | SynExpr.Record (inheritOpt, eo, xs, StartEndRange 1 (openingBrace, _, closingBrace)) ->
-        let inheritOpt = inheritOpt |> Option.map (fun (typ, expr, _, _, _) -> (typ, expr))
+        let inheritOpt = inheritOpt |> Option.map (fun (t, e, _, _, _) -> t, e)
 
         Some(openingBrace, inheritOpt, xs, Option.map fst eo, closingBrace)
     | _ -> None
