From ed45631092f7e2fe4050724b1943d36a100281e7 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?R=C3=A9mi=20Lef=C3=A8vre?= Date: Sun, 17 Nov 2019 00:43:58 +0100 Subject: [PATCH 1/2] Allow single-line case-expressions branches Resolves #507 --- parser/src/AST/Expression.hs | 2 +- parser/src/AST/Json.hs | 2 +- parser/src/Parse/Expression.hs | 18 ++- src/AST/MapExpr.hs | 10 +- src/ElmFormat/Render/Box.hs | 152 +++++++++++------- tests/Parse/ExpressionTest.hs | 10 +- .../good/Elm-0.19/AllSyntax/Expressions.elm | 14 +- 7 files changed, 125 insertions(+), 83 deletions(-) diff --git a/parser/src/AST/Expression.hs b/parser/src/AST/Expression.hs index 6d6816f36..cd71486e9 100644 --- a/parser/src/AST/Expression.hs +++ b/parser/src/AST/Expression.hs @@ -61,7 +61,7 @@ data Expr' | Lambda [(Comments, Pattern.Pattern)] Comments Expr Bool | If IfClause [(Comments, IfClause)] (Comments, Expr) | Let [LetDeclaration] Comments Expr - | Case (Commented Expr, Bool) [(Commented Pattern.Pattern, (Comments, Expr))] + | Case (Commented Expr, Multiline) [(Commented Pattern.Pattern, (Comments, Expr), Multiline)] -- for type checking and code gen only | GLShader String diff --git a/parser/src/AST/Json.hs b/parser/src/AST/Json.hs index 079cb473c..707a122c8 100644 --- a/parser/src/AST/Json.hs +++ b/parser/src/AST/Json.hs @@ -406,7 +406,7 @@ instance ToJSON Expr where , ( "subject", showJSON subject ) , ( "branches" , JSArray $ map - (\(Commented _ (A _ pat) _, (_, body)) -> + (\(Commented _ (A _ pat) _, (_, body), _) -> makeObj [ ("pattern", showJSON pat) , ("body", showJSON body) diff --git a/parser/src/Parse/Expression.hs b/parser/src/Parse/Expression.hs index 6df39a3e5..50ea3f544 100644 --- a/parser/src/Parse/Expression.hs +++ b/parser/src/Parse/Expression.hs @@ -234,21 +234,23 @@ caseExpr elmVersion = (e, multilineSubject) <- trackNewline $ (\(pre, e, post) -> Commented pre e post) <$> padded (expr elmVersion) reserved elmVersion "of" firstPatternComments <- whitespace - result <- cases firstPatternComments - return $ E.Case (e, multilineToBool multilineSubject) result + branches <- cases firstPatternComments + return $ E.Case (e, multilineSubject) branches where case_ preComments = do - (patternComments, p, (preArrowComments, _, bodyComments)) <- - try ((,,) + (patternComments, (p, multi), ((preArrowComments, _, bodyComments), multi')) <- + try $ (,,) <$> whitespace - <*> (checkIndent >> Pattern.expr elmVersion) - <*> padded rightArrow - ) - result <- expr elmVersion + <*> trackNewline (checkIndent >> Pattern.expr elmVersion) + <*> trackNewline (padded rightArrow) + (result, multi'') <- trackNewline $ expr elmVersion return ( Commented (preComments ++ patternComments) p preArrowComments , (bodyComments, result) + , case (multi, multi', multi'') of + (JoinAll, JoinAll, JoinAll) -> JoinAll + _ -> SplitAll ) cases preComments = diff --git a/src/AST/MapExpr.hs b/src/AST/MapExpr.hs index d6035ea0c..0dad4e996 100644 --- a/src/AST/MapExpr.hs +++ b/src/AST/MapExpr.hs @@ -32,12 +32,12 @@ instance MapExpr a => MapExpr [a] where mapExpr f list = fmap (mapExpr f) list -instance MapExpr a => MapExpr (a, Bool) where - mapExpr f (a, b) = (mapExpr f a, b) +instance MapExpr a => MapExpr (a, Multiline) where + mapExpr f (a, multi) = (mapExpr f a, multi) -instance MapExpr a => MapExpr (Commented Pattern, a) where - mapExpr f (x, a) = (x, mapExpr f a) +instance MapExpr a => MapExpr (Commented Pattern, a, Multiline) where + mapExpr f (x, a, multi) = (x, mapExpr f a, multi) instance MapExpr a => MapExpr (Comments, Ref, Comments, a) where @@ -85,7 +85,7 @@ instance MapExpr Expr' where If (mapExpr f c1) (mapExpr f elseIfs) (mapExpr f els) Let decls pre body -> Let (mapExpr f decls) pre body - Case cond branches -> + Case cond branches -> Case (mapExpr f cond) (mapExpr f branches) GLShader _ -> expr diff --git a/src/ElmFormat/Render/Box.hs b/src/ElmFormat/Render/Box.hs index ab0d96660..e76436bab 100644 --- a/src/ElmFormat/Render/Box.hs +++ b/src/ElmFormat/Render/Box.hs @@ -1284,8 +1284,8 @@ formatPair formatA delim formatB (AST.Pair a b (AST.ForceMultiline forceMultilin (formatHeadCommented formatB b) -negativeCasePatternWorkaround :: AST.Commented AST.Pattern.Pattern -> Box -> Box -negativeCasePatternWorkaround (AST.Commented _ (RA.A _ pattern) _) = +negativeCasePatternWorkaround :: AST.Pattern.Pattern -> Box -> Box +negativeCasePatternWorkaround (RA.A _ pattern) = case pattern of AST.Pattern.Literal (AST.IntNum i _) | i < 0 -> parens AST.Pattern.Literal (AST.FloatNum f _) | f < 0 -> parens @@ -1493,65 +1493,9 @@ formatExpression' elmVersion importInfo context aexpr = ] |> expressionParens AmbiguousEnd context -- TODO: not tested - AST.Expression.Case (subject,multiline) clauses -> - let - opening = - case - ( multiline - , formatCommentedExpression elmVersion importInfo SyntaxSeparated subject - ) - of - (False, SingleLine subject') -> - line $ row - [ keyword "case" - , space - , subject' - , space - , keyword "of" - ] - (_, subject') -> - stack1 - [ line $ keyword "case" - , indent subject' - , line $ keyword "of" - ] - - clause (pat, expr) = - case - ( pat - , (formatPattern elmVersion False $ (\(AST.Commented _ x _) -> x) pat) - |> negativeCasePatternWorkaround pat - , formatCommentedStack (formatPattern elmVersion False) pat - |> negativeCasePatternWorkaround pat - , formatHeadCommentedStack (formatExpression elmVersion importInfo SyntaxSeparated) expr - ) - of - (_, _, SingleLine pat', body') -> - stack1 - [ line $ row [ pat', space, keyword "->"] - , indent body' - ] - (AST.Commented pre _ [], SingleLine pat', _, body') -> - stack1 $ - (map formatComment pre) - ++ [ line $ row [ pat', space, keyword "->"] - , indent body' - ] - (_, _, pat', body') -> - stack1 $ - [ pat' - , line $ keyword "->" - , indent body' - ] - in - opening - |> andThen - (clauses - |> map clause - |> List.intersperse blankLine - |> map indent - ) - |> expressionParens AmbiguousEnd context -- TODO: not tested + AST.Expression.Case subject branches -> + formatCaseExpression elmVersion importInfo subject branches + |> expressionParens AmbiguousEnd context -- TODO: not tested AST.Expression.Tuple exprs multiline -> ElmStructure.group True "(" "," ")" multiline $ map (formatCommentedExpression elmVersion importInfo SyntaxSeparated) exprs @@ -1595,6 +1539,92 @@ formatExpression' elmVersion importInfo context aexpr = ] +formatCaseExpression :: + ElmVersion + -> ImportInfo + -> (AST.Commented AST.Expression.Expr, AST.Multiline) + -> [(AST.Commented AST.Pattern.Pattern, (AST.Comments, AST.Expression.Expr), AST.Multiline)] + -> Box +formatCaseExpression elmVersion importInfo subject branches = + let + branchBoxes multilineAcc (AST.Commented prePat pat postPat, (preBody, body), multilineBranch) = + let + (prePat', pat', postPat') = + ( Maybe.maybeToList $ formatComments prePat + , formatPattern elmVersion False pat |> negativeCasePatternWorkaround pat + , Maybe.maybeToList $ formatComments postPat + ) + (preBody', body') = + ( Maybe.maybeToList $ formatComments preBody + , formatExpression elmVersion importInfo SyntaxSeparated body + ) + (singlesPat, singlesBody) = + ( allSingles $ concat [ prePat', [pat'], postPat'] + , allSingles $ concat [ preBody', [body']] + ) + in + case (multilineBranch, singlesPat, singlesBody) of + (AST.JoinAll, Right patLines, Right bodyLines) -> + (multilineAcc, Right (patLines, bodyLines)) + _ -> + (AST.SplitAll, Left (prePat', pat', postPat', preBody', body')) + + (multilineBranches, branches') = + List.mapAccumR branchBoxes AST.JoinAll branches + + branch multiline' boxes = + case (multiline', boxes) of + (AST.JoinAll, Right (patLines, bodyLines)) -> + line $ row $ List.intersperse space $ patLines ++ [keyword "->"] ++ bodyLines + (AST.SplitAll, Right (patLines, bodyLines)) -> + stack1 + [ line $ row $ List.intersperse space $ patLines ++ [keyword "->"] + , indent $ line $ row $ bodyLines + ] + (_, Left ([], SingleLine pat, [], preBody, body)) -> + stack1 + [ line $ row [pat, space, keyword "->"] + , indent $ stack1 $ preBody ++ [body] + ] + (_, Left (prePat, SingleLine pat', [], preBody, body)) -> + stack1 + [ stack1 prePat + , line $ row [pat', space, keyword "->"] + , indent $ stack1 $ preBody ++ [body] + ] + (_, Left (prePat, pat, postPat, preBody, body)) -> + stack1 + [ stack1 $ prePat ++ [pat] ++ postPat + , line $ keyword "->" + , indent $ stack1 $ preBody ++ [body] + ] + in + formatCaseExpressionOpening elmVersion importInfo subject + |> andThen + (branches' + |> fmap (branch multilineBranches) + |> (if AST.isMultiline multilineBranches then List.intersperse blankLine else id) + |> fmap indent + ) + +formatCaseExpressionOpening :: ElmVersion -> ImportInfo -> (AST.Commented AST.Expression.Expr, AST.Multiline) -> Box +formatCaseExpressionOpening elmVersion importInfo (subject, multiline) = + case + ( multiline + , formatCommentedExpression elmVersion importInfo SyntaxSeparated subject + ) + of + (AST.JoinAll, SingleLine subject') -> + line $ row [ keyword "case" , space , subject' , space , keyword "of" ] + + (_, subject') -> + stack1 + [ line $ keyword "case" + , indent subject' + , line $ keyword "of" + ] + + formatCommentedExpression :: ElmVersion -> ImportInfo -> ExpressionContext -> AST.Commented AST.Expression.Expr -> Box formatCommentedExpression elmVersion importInfo context (AST.Commented pre e post) = let diff --git a/tests/Parse/ExpressionTest.hs b/tests/Parse/ExpressionTest.hs index 0d91dbe63..91129a4b7 100644 --- a/tests/Parse/ExpressionTest.hs +++ b/tests/Parse/ExpressionTest.hs @@ -282,11 +282,11 @@ tests = ] , testGroup "case statement" - [ example "" "case 9 of\n 1->10\n _->20" $ at 1 1 3 7 (Case (Commented [] (at 1 6 1 7 (Literal (IntNum 9 DecimalInt))) [],False) [(Commented [] (at 2 2 2 3 (P.Literal (IntNum 1 DecimalInt))) [],([],at 2 5 2 7 (Literal (IntNum 10 DecimalInt)))),(Commented [] (at 3 2 3 3 Anything) [],([],at 3 5 3 7 (Literal (IntNum 20 DecimalInt))))]) - , example "no newline after 'of'" "case 9 of 1->10\n _->20" $ at 1 1 2 16 (Case (Commented [] (at 1 6 1 7 (Literal (IntNum 9 DecimalInt))) [],False) [(Commented [] (at 1 11 1 12 (P.Literal (IntNum 1 DecimalInt))) [],([],at 1 14 1 16 (Literal (IntNum 10 DecimalInt)))),(Commented [] (at 2 11 2 12 Anything) [],([],at 2 14 2 16 (Literal (IntNum 20 DecimalInt))))]) - , example "whitespace" "case 9 of\n 1 -> 10\n _ -> 20" $ at 1 1 3 9 (Case (Commented [] (at 1 6 1 7 (Literal (IntNum 9 DecimalInt))) [],False) [(Commented [] (at 2 2 2 3 (P.Literal (IntNum 1 DecimalInt))) [],([],at 2 7 2 9 (Literal (IntNum 10 DecimalInt)))),(Commented [] (at 3 2 3 3 Anything) [],([],at 3 7 3 9 (Literal (IntNum 20 DecimalInt))))]) - , example "comments" "case{-A-}9{-B-}of{-C-}\n{-D-}1{-E-}->{-F-}10{-G-}\n{-H-}_{-I-}->{-J-}20" $ at 1 1 3 21 (Case (Commented [BlockComment ["A"]] (at 1 10 1 11 (Literal (IntNum 9 DecimalInt))) [BlockComment ["B"]],False) [(Commented [BlockComment ["C"],BlockComment ["D"]] (at 2 6 2 7 (P.Literal (IntNum 1 DecimalInt))) [BlockComment ["E"]],([BlockComment ["F"]],at 2 19 2 21 (Literal (IntNum 10 DecimalInt)))),(Commented [BlockComment ["G"],BlockComment ["H"]] (at 3 6 3 7 Anything) [BlockComment ["I"]],([BlockComment ["J"]],at 3 19 3 21 (Literal (IntNum 20 DecimalInt))))]) - , example "newlines" "case\n 9\n of\n 1\n ->\n 10\n _\n ->\n 20" $ at 1 1 9 4 (Case (Commented [] (at 2 2 2 3 (Literal (IntNum 9 DecimalInt))) [],True) [(Commented [] (at 4 2 4 3 (P.Literal (IntNum 1 DecimalInt))) [],([],at 6 2 6 4 (Literal (IntNum 10 DecimalInt)))),(Commented [] (at 7 2 7 3 Anything) [],([],at 9 2 9 4 (Literal (IntNum 20 DecimalInt))))]) + [ example "" "case 9 of\n 1->10\n _->20" $ at 1 1 3 7 (Case (Commented [] (at 1 6 1 7 (Literal (IntNum 9 DecimalInt))) [],JoinAll) [(Commented [] (at 2 2 2 3 (P.Literal (IntNum 1 DecimalInt))) [],([],at 2 5 2 7 (Literal (IntNum 10 DecimalInt))),JoinAll),(Commented [] (at 3 2 3 3 Anything) [],([],at 3 5 3 7 (Literal (IntNum 20 DecimalInt))), JoinAll)]) + , example "no newline after 'of'" "case 9 of 1->10\n _->20" $ at 1 1 2 16 (Case (Commented [] (at 1 6 1 7 (Literal (IntNum 9 DecimalInt))) [],JoinAll) [(Commented [] (at 1 11 1 12 (P.Literal (IntNum 1 DecimalInt))) [],([],at 1 14 1 16 (Literal (IntNum 10 DecimalInt))),JoinAll),(Commented [] (at 2 11 2 12 Anything) [],([],at 2 14 2 16 (Literal (IntNum 20 DecimalInt))),JoinAll)]) + , example "whitespace" "case 9 of\n 1 -> 10\n _ -> 20" $ at 1 1 3 9 (Case (Commented [] (at 1 6 1 7 (Literal (IntNum 9 DecimalInt))) [],JoinAll) [(Commented [] (at 2 2 2 3 (P.Literal (IntNum 1 DecimalInt))) [],([],at 2 7 2 9 (Literal (IntNum 10 DecimalInt))),JoinAll),(Commented [] (at 3 2 3 3 Anything) [],([],at 3 7 3 9 (Literal (IntNum 20 DecimalInt))),JoinAll)]) + , example "comments" "case{-A-}9{-B-}of{-C-}\n{-D-}1{-E-}->{-F-}10{-G-}\n{-H-}_{-I-}->{-J-}20" $ at 1 1 3 21 (Case (Commented [BlockComment ["A"]] (at 1 10 1 11 (Literal (IntNum 9 DecimalInt))) [BlockComment ["B"]],JoinAll) [(Commented [BlockComment ["C"],BlockComment ["D"]] (at 2 6 2 7 (P.Literal (IntNum 1 DecimalInt))) [BlockComment ["E"]],([BlockComment ["F"]],at 2 19 2 21 (Literal (IntNum 10 DecimalInt))),JoinAll),(Commented [BlockComment ["G"],BlockComment ["H"]] (at 3 6 3 7 Anything) [BlockComment ["I"]],([BlockComment ["J"]],at 3 19 3 21 (Literal (IntNum 20 DecimalInt))),JoinAll)]) + , example "newlines" "case\n 9\n of\n 1\n ->\n 10\n _\n ->\n 20" $ at 1 1 9 4 (Case (Commented [] (at 2 2 2 3 (Literal (IntNum 9 DecimalInt))) [], SplitAll) [(Commented [] (at 4 2 4 3 (P.Literal (IntNum 1 DecimalInt))) [],([],at 6 2 6 4 (Literal (IntNum 10 DecimalInt))),SplitAll),(Commented [] (at 7 2 7 3 Anything) [],([],at 9 2 9 4 (Literal (IntNum 20 DecimalInt))),SplitAll)]) , testCase "should not consume trailing whitespace" $ assertParse (expr Elm_0_19>> string "\nX") "case 9 of\n 1->10\n _->20\nX" $ "\nX" , testGroup "clauses must start at the same column" diff --git a/tests/test-files/good/Elm-0.19/AllSyntax/Expressions.elm b/tests/test-files/good/Elm-0.19/AllSyntax/Expressions.elm index 96e70aabb..7d8e5b3ae 100644 --- a/tests/test-files/good/Elm-0.19/AllSyntax/Expressions.elm +++ b/tests/test-files/good/Elm-0.19/AllSyntax/Expressions.elm @@ -339,6 +339,16 @@ letStatement = caseStatement = let a = + case Just 1 of + Just x -> x + _ -> 2 + + b = + case {- A -} Just 1 {- B -} of + Just x {- C -} -> {- D -} x + _ {- E -} -> {- F -} 2 + + c = case Just 1 of Just x -> x @@ -346,7 +356,7 @@ caseStatement = _ -> 2 - b = + d = case {- M -} Just 1 {- N -} of {- O -} Just x @@ -362,7 +372,7 @@ caseStatement = {- T -} 2 - c = + e = case --M Just 1 From efbecb90e3901abbd544a8768513cf4d9862d72d Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?R=C3=A9mi=20Lef=C3=A8vre?= Date: Fri, 22 Nov 2019 23:30:54 +0100 Subject: [PATCH 2/2] Add consecutive comments tests for `case` expressions --- .../good/Elm-0.19/AllSyntax/Expressions.elm | 77 +++++++++++++++---- 1 file changed, 63 insertions(+), 14 deletions(-) diff --git a/tests/test-files/good/Elm-0.19/AllSyntax/Expressions.elm b/tests/test-files/good/Elm-0.19/AllSyntax/Expressions.elm index 7d8e5b3ae..1a761dca7 100644 --- a/tests/test-files/good/Elm-0.19/AllSyntax/Expressions.elm +++ b/tests/test-files/good/Elm-0.19/AllSyntax/Expressions.elm @@ -349,6 +349,11 @@ caseStatement = _ {- E -} -> {- F -} 2 c = + case {- A -} {- B -} Just 1 {- C -} {- D -} of + Just x {- E -} {- F -} -> {- G -} {- H -} x + _ {- I -} {- J -} -> {- K -} {- L -} 2 + + d = case Just 1 of Just x -> x @@ -356,13 +361,13 @@ caseStatement = _ -> 2 - d = - case {- M -} Just 1 {- N -} of - {- O -} + e = + case {- A -} Just 1 {- B -} of + {- C -} Just x - {- P -} + {- D -} -> - {- Q -} + {- E -} x {- R -} @@ -372,24 +377,68 @@ caseStatement = {- T -} 2 - e = + f = case - --M + --A Just 1 - --N + --B of - --O + --C + Just x + --D + -> + --E + x + + --F + _ + --G + -> + --H + 2 + + g = + case {- A -} {- B -} Just 1 {- C -} {- D -} of + {- E -} {- F -} Just x - --P + {- G -} {- H -} -> - --Q + {- I -} {- J -} x - --R + {- K -} {- L -} _ - --S + {- M -} {- N -} + -> + {- O -} {- P -} + 2 + + h = + case + --A + --B + Just 1 + --C + --D + of + --E + --F + Just x + --G + --H + -> + --I + --J + x + + --K + --L + _ + --M + --N -> - --T + --O + --P 2 in {}