Long generic constraints

CHANGELOG.md

@@ -9,6 +9,8 @@
 ### Changed
 * Formatting of multi-constrained SRTP functions needs improvement. [#2230](https://github.com/fsprojects/fantomas/issues/2230)
 * Try/With with a single clause. [#1881](https://github.com/fsprojects/fantomas/issues/1881)
+* Long type argument with constraints is not respecting max_line_length. [#2266](https://github.com/fsprojects/fantomas/issues/2266)
+* Long function argument with constraints is not respecting max_line_length. [#2267](https://github.com/fsprojects/fantomas/issues/2267)
 
 ### Removed
 

src/Fantomas.Core.Tests/ClassTests.fs

@@ -821,8 +821,8 @@ type ISingleExpressionValue<'p, 'o, 'v when 'p :> IProperty and 'o :> IOperator
     |> should
         equal
         """
-type ISingleExpressionValue<'p, 'o, 'v when 'p :> IProperty and 'o :> IOperator and 'p: equality and 'o: equality and 'v: equality>
-    () =
+type ISingleExpressionValue<'p, 'o, 'v
+    when 'p :> IProperty and 'o :> IOperator and 'p: equality and 'o: equality and 'v: equality>() =
     abstract Property: 'p
     abstract Operator: 'o
     abstract Value: 'v

src/Fantomas.Core.Tests/LetBindingTests.fs

@@ -1994,3 +1994,42 @@ let escapeEarth myVelocity mySpeed =
     else
         "Come back"
 """
+
+[<Test>]
+let ``long value with constraints, 2267`` () =
+    formatSourceString
+        false
+        """
+let inline NonStructural<'TInput when 'TInput: (static member (<): 'TInput * 'TInput -> bool) and 'TInput: (static member (>): 'TInput * 'TInput -> bool)> : IComparer<'TInput> = ()
+"""
+        config
+    |> prepend newline
+    |> should
+        equal
+        """
+let inline NonStructural<'TInput
+    when 'TInput: (static member (<): 'TInput * 'TInput -> bool)
+    and 'TInput: (static member (>): 'TInput * 'TInput -> bool)> : IComparer<'TInput> =
+    ()
+"""
+
+[<Test>]
+let ``long function with constraints, 2267`` () =
+    formatSourceString
+        false
+        """
+let inline NonStructural<'TInput when 'TInput: (static member (<): 'TInput * 'TInput -> bool) and 'TInput: (static member (>): 'TInput * 'TInput -> bool)>  (a:'TInput) (b:'TInput) : IComparer<'TInput> = ()
+"""
+        config
+    |> prepend newline
+    |> should
+        equal
+        """
+let inline NonStructural<'TInput
+    when 'TInput: (static member (<): 'TInput * 'TInput -> bool)
+    and 'TInput: (static member (>): 'TInput * 'TInput -> bool)>
+    (a: 'TInput)
+    (b: 'TInput)
+    : IComparer<'TInput> =
+    ()
+"""

src/Fantomas.Core.Tests/TypeDeclarationTests.fs

@@ -1659,7 +1659,8 @@ type SomeType =
 let ``access modifier before long constructor`` () =
     formatSourceString
         false
-        """type INotifications<'a,'b,'c,'d,'e> =
+        """
+type INotifications<'a,'b,'c,'d,'e> =
     class
     end
 type DeviceNotificationHandler<'Notification, 'CallbackId, 'RegisterInputData, 'RegisterOutputData, 'UnregisterOutputData> private (client: INotifications<'Notification, 'CallbackId, 'RegisterInputData, 'RegisterOutputData, 'UnregisterOutputData>, callbackId: 'CallbackId, validateUnregisterOutputData: 'UnregisterOutputData -> unit) =
@@ -3082,3 +3083,43 @@ type MethInfo =
     member ProvidedStaticParameterInfo: (Tainted<ProvidedMethodBase> * Tainted<ProvidedParameterInfo>[]) option
 #endif
 """
+
+[<Test>]
+let ``long type argument with constraints, 2266`` () =
+    formatSourceString
+        false
+        """
+type Event<'Delegate, 'Args when 'Delegate: delegate<'Args, unit> and 'Delegate :> System.Delegate and 'Delegate: not struct> () =
+                        class end
+"""
+        config
+    |> prepend newline
+    |> should
+        equal
+        """
+type Event<'Delegate, 'Args
+    when 'Delegate: delegate<'Args, unit> and 'Delegate :> System.Delegate and 'Delegate: not struct>() =
+    class
+    end
+"""
+
+[<Test>]
+let ``long type argument with constraints, short max_line_length`` () =
+    formatSourceString
+        false
+        """
+type Event<'Delegate, 'Args when 'Delegate: delegate<'Args, unit> and 'Delegate :> System.Delegate and 'Delegate: not struct> () =
+                        class end
+"""
+        { config with MaxLineLength = 80 }
+    |> prepend newline
+    |> should
+        equal
+        """
+type Event<'Delegate, 'Args
+    when 'Delegate: delegate<'Args, unit>
+    and 'Delegate :> System.Delegate
+    and 'Delegate: not struct>() =
+    class
+    end
+"""

src/Fantomas.Core/CodePrinter.fs

@@ -615,7 +615,7 @@ and genTypeAndParam astContext (typeName: Context -> Context) (tds: SynTyparDecl
     let types openSep tds tcs closeSep =
         (!-openSep
          +> coli sepComma tds (fun i -> genTyparDecl { astContext with IsFirstTypeParam = i = 0 })
-         +> colPre (!- " when ") wordAnd tcs (genTypeConstraint astContext)
+         +> genSynTypeConstraintList astContext tcs
          -- closeSep)
 
     match tds with
@@ -633,10 +633,22 @@ and genTypeParamPostfix astContext tds =
     | Some (SynTyparDecls.PostfixList (tds, tcs, _range)) ->
         (!- "<"
          +> coli sepComma tds (fun i -> genTyparDecl { astContext with IsFirstTypeParam = i = 0 })
-         +> colPre (!- " when ") wordAnd tcs (genTypeConstraint astContext)
+         +> genSynTypeConstraintList astContext tcs
          -- ">")
     | _ -> sepNone
 
+and genSynTypeConstraintList astContext tcs =
+    match tcs with
+    | [] -> sepNone
+    | _ ->
+        let short =
+            colPre (sepSpace +> !- "when ") wordAnd tcs (genTypeConstraint astContext)
+
+        let long =
+            colPre (!- "when ") (sepNln +> wordAndFixed +> sepSpace) tcs (genTypeConstraint astContext)
+
+        autoIndentAndNlnIfExpressionExceedsPageWidth (expressionFitsOnRestOfLine short long)
+
 and genLetBinding astContext pref b =
     let genPref letKeyword =
         genTriviaForOption SynBinding_Let letKeyword !-pref