From 3e47fba17ed3cc1db43a8d9d8f495e0437b99ed4 Mon Sep 17 00:00:00 2001 From: nojaf Date: Thu, 26 Feb 2026 13:59:02 +0100 Subject: [PATCH 1/2] Improve formatting of query expressions with join/on/into clauses Add query-aware formatting in CodePrinter via genQueryExpr that handles JoinIn, CompExprBody, ForEach, and groupBy/groupValBy with into clauses. When inside a `query { }` computation expression, join keywords (on, into) are placed on their own indented lines, for...do bodies are not extra indented, and multiline items no longer trigger blank line separation. Fixes #3156 --- CHANGELOG.md | 4 + .../ComputationExpressionTests.fs | 26 ++ .../Fantomas.Core.Tests.fsproj | 1 + .../QueryExpressionTests.fs | 316 ++++++++++++++++++ src/Fantomas.Core/CodePrinter.fs | 145 ++++++++ 5 files changed, 492 insertions(+) create mode 100644 src/Fantomas.Core.Tests/QueryExpressionTests.fs diff --git a/CHANGELOG.md b/CHANGELOG.md index 599a16e66..43c89229e 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -2,6 +2,10 @@ ## [Unreleased] +### Changed + +- Improve formatting of query expressions with join/on/into clauses. [#3156](https://github.com/fsprojects/fantomas/issues/3156) + ### Fixed - End of line comments after infix operators are preserved correctly. [#2287](https://github.com/fsprojects/fantomas/issues/2287) diff --git a/src/Fantomas.Core.Tests/ComputationExpressionTests.fs b/src/Fantomas.Core.Tests/ComputationExpressionTests.fs index 6689203fc..69dfbc9d7 100644 --- a/src/Fantomas.Core.Tests/ComputationExpressionTests.fs +++ b/src/Fantomas.Core.Tests/ComputationExpressionTests.fs @@ -2339,6 +2339,32 @@ aggregateResult { } """ +[] +let ``multiline ExprJoinIn does not use atCurrentColumn, 3156`` () = + formatSourceString + """ +query { + for persons in database do + join items in database2 + on ((persons.LongIdName, persons.LongerIdName) = (items.LongIdName, items.LongerIdName)) + into result + select (persons, result) +} +""" + config + |> prepend newline + |> should + equal + """ +query { + for persons in database do + join items in database2 + on ((persons.LongIdName, persons.LongerIdName) = (items.LongIdName, items.LongerIdName)) + into result + select (persons, result) +} +""" + [] let ``line comment above SynExpr.LetOrUseBang`` () = formatSourceString diff --git a/src/Fantomas.Core.Tests/Fantomas.Core.Tests.fsproj b/src/Fantomas.Core.Tests/Fantomas.Core.Tests.fsproj index 433285415..e7128b96e 100644 --- a/src/Fantomas.Core.Tests/Fantomas.Core.Tests.fsproj +++ b/src/Fantomas.Core.Tests/Fantomas.Core.Tests.fsproj @@ -135,6 +135,7 @@ + diff --git a/src/Fantomas.Core.Tests/QueryExpressionTests.fs b/src/Fantomas.Core.Tests/QueryExpressionTests.fs new file mode 100644 index 000000000..41daf402e --- /dev/null +++ b/src/Fantomas.Core.Tests/QueryExpressionTests.fs @@ -0,0 +1,316 @@ +module Fantomas.Core.Tests.QueryExpressionTests + +open NUnit.Framework +open FsUnit +open Fantomas.Core.Tests.TestHelpers + +[] +let ``simple join`` () = + formatSourceString + """ +query { + for student in db.Student do + join selection in db.CourseSelection + on (student.StudentID = selection.StudentID) + select (student, selection) +} +""" + config + |> prepend newline + |> should + equal + """ +query { + for student in db.Student do + join selection in db.CourseSelection + on (student.StudentID = selection.StudentID) + select (student, selection) +} +""" + +[] +let ``groupJoin with on and into`` () = + formatSourceString + """ +query { + for student in db.Student do + groupJoin courseSelection in db.CourseSelection + on (student.StudentID = courseSelection.StudentID) into g + for courseSelection in g do + join course in db.Course + on (courseSelection.CourseID = course.CourseID) + select (student.Name, course.CourseName) +} +""" + config + |> prepend newline + |> should + equal + """ +query { + for student in db.Student do + groupJoin courseSelection in db.CourseSelection + on (student.StudentID = courseSelection.StudentID) + into g + for courseSelection in g do + join course in db.Course + on (courseSelection.CourseID = course.CourseID) + select (student.Name, course.CourseName) +} +""" + +[] +let ``leftOuterJoin with on and into`` () = + formatSourceString + """ +query { + for student in db.Student do + leftOuterJoin selection in db.CourseSelection + on (student.StudentID = selection.StudentID) into result + for selection in result.DefaultIfEmpty() do + select (student, selection) +} +""" + config + |> prepend newline + |> should + equal + """ +query { + for student in db.Student do + leftOuterJoin selection in db.CourseSelection + on (student.StudentID = selection.StudentID) + into result + for selection in result.DefaultIfEmpty() do + select (student, selection) +} +""" + +[] +let ``multiple joins`` () = + formatSourceString + """ +query { + for student in db.Student do + join courseSelection in db.CourseSelection + on (student.StudentID = courseSelection.StudentID) + join course in db.Course + on (courseSelection.CourseID = course.CourseID) + select (student.Name, course.CourseName) +} +""" + config + |> prepend newline + |> should + equal + """ +query { + for student in db.Student do + join courseSelection in db.CourseSelection + on (student.StudentID = courseSelection.StudentID) + join course in db.Course + on (courseSelection.CourseID = course.CourseID) + select (student.Name, course.CourseName) +} +""" + +[] +let ``multiple left outer joins`` () = + formatSourceString + """ +query { + for student in db.Student do + leftOuterJoin courseSelection in db.CourseSelection + on (student.StudentID = courseSelection.StudentID) into g1 + for courseSelection in g1.DefaultIfEmpty() do + leftOuterJoin course in db.Course + on (courseSelection.CourseID = course.CourseID) into g2 + for course in g2.DefaultIfEmpty() do + select (student.Name, course.CourseName) +} +""" + config + |> prepend newline + |> should + equal + """ +query { + for student in db.Student do + leftOuterJoin courseSelection in db.CourseSelection + on (student.StudentID = courseSelection.StudentID) + into g1 + for courseSelection in g1.DefaultIfEmpty() do + leftOuterJoin course in db.Course + on (courseSelection.CourseID = course.CourseID) + into g2 + for course in g2.DefaultIfEmpty() do + select (student.Name, course.CourseName) +} +""" + +[] +let ``join with distinct`` () = + formatSourceString + """ +query { + for student in db.Student do + join selection in db.CourseSelection + on (student.StudentID = selection.StudentID) + distinct +} +""" + config + |> prepend newline + |> should + equal + """ +query { + for student in db.Student do + join selection in db.CourseSelection + on (student.StudentID = selection.StudentID) + distinct +} +""" + +[] +let ``multiline join with on and into, 3156`` () = + formatSourceString + """ +query { + for persons in database do + join items in database2 + on ((persons.LongIdName, persons.LongerIdName) = (items.LongIdName, items.LongerIdName)) + into result + select (persons, result) +} +""" + config + |> prepend newline + |> should + equal + """ +query { + for persons in database do + join items in database2 + on ((persons.LongIdName, persons.LongerIdName) = (items.LongIdName, items.LongerIdName)) + into result + select (persons, result) +} +""" + +[] +let ``groupBy with into`` () = + formatSourceString + """ +query { + for student in db.Student do + groupBy student.Age into g + select (g.Key, g.Count()) +} +""" + config + |> prepend newline + |> should + equal + """ +query { + for student in db.Student do + groupBy student.Age into g + select (g.Key, g.Count()) +} +""" + +[] +let ``groupValBy with into`` () = + formatSourceString + """ +query { + for student in db.Student do + groupValBy student.Name student.Age into g + select (g, g.Key, g.Count()) +} +""" + config + |> prepend newline + |> should + equal + """ +query { + for student in db.Student do + groupValBy student.Name student.Age into g + select (g, g.Key, g.Count()) +} +""" + +[] +let ``blank lines between query statements are preserved`` () = + formatSourceString + """ +query { + for student in db.Student do + + join selection in db.CourseSelection + on (student.StudentID = selection.StudentID) + + select (student, selection) +} +""" + config + |> prepend newline + |> should + equal + """ +query { + for student in db.Student do + + join selection in db.CourseSelection + on (student.StudentID = selection.StudentID) + + select (student, selection) +} +""" + +[] +let ``nested query in async, 3156`` () = + formatSourceString + """ +let exampleCode + (database : dbContext) + (id : int) + : Async = + async { + return! + query { + for persons in database1 do + join items in database2 + on ((persons.LongIdName, persons.LongerIdName) = (items.LongIdName, items.LongerIdName)) + into result + for i in result.DefaultIfEmpty() do + select (a.LongIdName, a.AccountId) + distinct + } + |> AsyncExtensions.ToArrayAsync + |> Async.AwaitTask + } +""" + config + |> prepend newline + |> should + equal + """ +let exampleCode (database: dbContext) (id: int) : Async = + async { + return! + query { + for persons in database1 do + join items in database2 + on ((persons.LongIdName, persons.LongerIdName) = (items.LongIdName, items.LongerIdName)) + into result + for i in result.DefaultIfEmpty() do + select (a.LongIdName, a.AccountId) + distinct + } + |> AsyncExtensions.ToArrayAsync + |> Async.AwaitTask + } +""" diff --git a/src/Fantomas.Core/CodePrinter.fs b/src/Fantomas.Core/CodePrinter.fs index 1e645d3f7..41f80840b 100644 --- a/src/Fantomas.Core/CodePrinter.fs +++ b/src/Fantomas.Core/CodePrinter.fs @@ -8,6 +8,41 @@ open Microsoft.FSharp.Core.CompilerServices let noBreakInfixOps = set [| "="; ">"; "<"; "%" |] let newLineInfixOps = set [ "|>"; "||>"; "|||>"; ">>"; ">>=" ] +let (|IdentText|_|) (text: string) (e: Expr) = + match e with + | Expr.Ident stn when stn.Text = text -> Some stn + | _ -> None + +/// Matches an ExprAppNode that follows the query join RHS pattern: +/// source on condition [into name] +let (|QueryJoinRhs|_|) (expr: Expr) = + match expr with + | Expr.App appNode -> + match appNode.Arguments with + | [ IdentText "on" onNode; condition ] -> Some(appNode.FunctionExpr, onNode, condition, None) + | [ IdentText "on" onNode; condition; IdentText "into" intoNode; target ] -> + Some(appNode.FunctionExpr, onNode, condition, Some(intoNode, target)) + | _ -> None + | _ -> None + +/// Matches a query expression application with an `into` clause: +/// groupBy expr into name, groupValBy expr expr into name +let (|QueryGroupInto|_|) (expr: Expr) = + match expr with + | Expr.App appNode -> + let args = appNode.Arguments + + let rec splitAtInto before = + function + | (IdentText "into" intoNode) :: rest -> Some(List.rev before, intoNode, rest) + | arg :: rest -> splitAtInto (arg :: before) rest + | [] -> None + + match splitAtInto [] args with + | Some(beforeArgs, intoNode, afterArgs) -> Some(appNode.FunctionExpr, beforeArgs, intoNode, afterArgs) + | None -> None + | _ -> None + let rec (|UppercaseType|LowercaseType|) (t: Type) : Choice = let upperOrLower (v: string) = let isUpper = Seq.tryHead v |> Option.map Char.IsUpper |> Option.defaultValue false @@ -353,6 +388,93 @@ let isLambdaOrIfThenElse (e: Expr) = let (|IsLambdaOrIfThenElse|_|) (e: Expr) = if isLambdaOrIfThenElse e then Some e else None +/// Generate an expression in a query computation expression context. +/// Handles JoinIn, CompExprBody, and ForEach with query-aware formatting, +/// delegating to genExpr for all other expression types. +let genQueryExpr (e: Expr) = + match e with + | Expr.JoinIn node -> + let genQueryJoinInRhs = + match node.RightHandSide with + | QueryJoinRhs(sourceExpr, onNode, condition, intoClause) -> + sepSpace + +> genExpr sourceExpr + +> indent + +> sepNln + +> genSingleTextNode onNode + +> sepSpace + +> genExpr condition + +> opt sepNone intoClause (fun (intoNode, target) -> + sepNln +> genSingleTextNode intoNode +> sepSpace +> genExpr target) + +> unindent + | _ -> sepSpaceOrIndentAndNlnIfExpressionExceedsPageWidth (genExpr node.RightHandSide) + + genExpr node.LeftHandSide + +> sepSpace + +> genSingleTextNode node.In + +> genQueryJoinInRhs + |> genNode node + | QueryGroupInto(funcExpr, beforeArgs, intoNode, afterArgs) -> + let genShort = + genExpr funcExpr + +> sepSpace + +> col sepSpace beforeArgs genExpr + +> sepSpace + +> genSingleTextNode intoNode + +> sepSpace + +> col sepSpace afterArgs genExpr + + let genLong = + genExpr funcExpr + +> sepSpace + +> col sepSpace beforeArgs genExpr + +> indent + +> sepNln + +> genSingleTextNode intoNode + +> sepSpace + +> col sepSpace afterArgs genExpr + +> unindent + + expressionFitsOnRestOfLine genShort genLong |> genNode (Expr.Node e) + | Expr.CompExprBody node -> + let genStatements = + node.Statements + |> List.mapi (fun i statement -> + let gen = + match statement with + | ComputationExpressionStatement.BindingStatement bindingNode -> genBinding bindingNode + | ComputationExpressionStatement.OtherStatement e -> genQueryExpr e + + if i = 0 then + gen + else + let node = + match statement with + | ComputationExpressionStatement.BindingStatement bindingNode -> bindingNode :> Node + | ComputationExpressionStatement.OtherStatement e -> Expr.Node e + + sepNlnUnlessContentBefore node +> gen) + |> List.reduce (+>) + |> genNode node + + match node.Statements with + | [ ComputationExpressionStatement.BindingStatement bindingNode + ComputationExpressionStatement.OtherStatement otherNode ] when bindingNode.In.IsSome -> + let short = genBinding bindingNode +> sepSpace +> genQueryExpr otherNode + expressionFitsOnRestOfLine short genStatements + | _ -> genStatements + | Expr.ForEach node -> + genSingleTextNode node.For + +> sepSpace + +> genPat node.Pattern + +> !-" in " + +> autoIndentAndNlnIfExpressionExceedsPageWidth (genExpr node.EnumExpr) + +> ifElse node.IsArrow sepArrow !-" do" + +> sepNln + +> genQueryExpr node.BodyExpr + |> genNode node + | _ -> genExpr e + let genExpr (e: Expr) = match e with | Expr.Lazy node -> @@ -618,6 +740,29 @@ let genExpr (e: Expr) = (!-" do" +> indent +> sepNln +> genExpr node.BodyExpr +> unindent) ) |> genNode node + | Expr.NamedComputation node when + (match node.Name with + | IdentText "query" _ -> true + | _ -> false) + -> + let short = + genExpr node.Name + +> sepSpace + +> genSingleTextNode node.OpeningBrace + +> addSpaceIfSpaceAroundDelimiter + +> genQueryExpr node.Body + +> addSpaceIfSpaceAroundDelimiter + +> genSingleTextNode node.ClosingBrace + + let long = + genExpr node.Name + +> sepSpace + +> genSingleTextNode node.OpeningBrace + +> indentSepNlnUnindent (genQueryExpr node.Body) + +> sepNln + +> genSingleTextNode node.ClosingBrace + + expressionFitsOnRestOfLine short long |> genNode node | Expr.NamedComputation node -> let short = genExpr node.Name From 8558be005d9d832ed371a86271edc3de8684c799 Mon Sep 17 00:00:00 2001 From: nojaf Date: Thu, 26 Feb 2026 14:22:56 +0100 Subject: [PATCH 2/2] Address analyzer feedback --- src/Fantomas.Core/CodePrinter.fs | 25 ++++++++++++++----------- 1 file changed, 14 insertions(+), 11 deletions(-) diff --git a/src/Fantomas.Core/CodePrinter.fs b/src/Fantomas.Core/CodePrinter.fs index 41f80840b..2d415bd40 100644 --- a/src/Fantomas.Core/CodePrinter.fs +++ b/src/Fantomas.Core/CodePrinter.fs @@ -8,25 +8,28 @@ open Microsoft.FSharp.Core.CompilerServices let noBreakInfixOps = set [| "="; ">"; "<"; "%" |] let newLineInfixOps = set [ "|>"; "||>"; "|||>"; ">>"; ">>=" ] +[] let (|IdentText|_|) (text: string) (e: Expr) = match e with - | Expr.Ident stn when stn.Text = text -> Some stn - | _ -> None + | Expr.Ident stn when stn.Text = text -> ValueSome stn + | _ -> ValueNone /// Matches an ExprAppNode that follows the query join RHS pattern: /// source on condition [into name] +[] let (|QueryJoinRhs|_|) (expr: Expr) = match expr with | Expr.App appNode -> match appNode.Arguments with - | [ IdentText "on" onNode; condition ] -> Some(appNode.FunctionExpr, onNode, condition, None) + | [ IdentText "on" onNode; condition ] -> ValueSome(appNode.FunctionExpr, onNode, condition, None) | [ IdentText "on" onNode; condition; IdentText "into" intoNode; target ] -> - Some(appNode.FunctionExpr, onNode, condition, Some(intoNode, target)) - | _ -> None - | _ -> None + ValueSome(appNode.FunctionExpr, onNode, condition, Some(intoNode, target)) + | _ -> ValueNone + | _ -> ValueNone /// Matches a query expression application with an `into` clause: /// groupBy expr into name, groupValBy expr expr into name +[] let (|QueryGroupInto|_|) (expr: Expr) = match expr with | Expr.App appNode -> @@ -34,14 +37,14 @@ let (|QueryGroupInto|_|) (expr: Expr) = let rec splitAtInto before = function - | (IdentText "into" intoNode) :: rest -> Some(List.rev before, intoNode, rest) + | (IdentText "into" intoNode) :: rest -> ValueSome(List.rev before, intoNode, rest) | arg :: rest -> splitAtInto (arg :: before) rest - | [] -> None + | [] -> ValueNone match splitAtInto [] args with - | Some(beforeArgs, intoNode, afterArgs) -> Some(appNode.FunctionExpr, beforeArgs, intoNode, afterArgs) - | None -> None - | _ -> None + | ValueSome(beforeArgs, intoNode, afterArgs) -> ValueSome(appNode.FunctionExpr, beforeArgs, intoNode, afterArgs) + | ValueNone -> ValueNone + | _ -> ValueNone let rec (|UppercaseType|LowercaseType|) (t: Type) : Choice = let upperOrLower (v: string) =