Skip to content
New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

Sign up for GitHub

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Allow single-line case-expressions branches #649

Open
wants to merge 2 commits into
base: main
Choose a base branch
from
Open

Allow single-line case-expressions branches #649

Show file tree
Hide file tree
Changes from all commits
Commits
Show all changes
2 commits
Select commit Hold shift + click to select a range
ed45631
Allow single-line case-expressions branches
rlefevre Nov 16, 2019
efbecb9
Add consecutive comments tests for `case` expressions
rlefevre Nov 22, 2019
File filter

Filter by extension

Filter by extension
Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
2 changes: 1 addition & 1 deletion parser/src/AST/Expression.hs
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand Down
2 changes: 1 addition & 1 deletion parser/src/AST/Json.hs
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -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)
Expand Down
18 changes: 10 additions & 8 deletions parser/src/Parse/Expression.hs
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -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
rlefevre marked this conversation as resolved.
Show resolved Hide resolved
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 =
Expand Down
10 changes: 5 additions & 5 deletions src/AST/MapExpr.hs
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand Down Expand Up @@ -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

Expand Down
152 changes: 91 additions & 61 deletions src/ElmFormat/Render/Box.hs
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand Down Expand Up @@ -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
rlefevre marked this conversation as resolved.
Show resolved Hide resolved
)
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
Expand Down Expand Up @@ -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
Expand Down
10 changes: 5 additions & 5 deletions tests/Parse/ExpressionTest.hs
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -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"
Expand Down
87 changes: 73 additions & 14 deletions tests/test-files/good/Elm-0.19/AllSyntax/Expressions.elm
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -339,20 +339,35 @@ 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 {- 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

_ ->
2

b =
case {- M -} Just 1 {- N -} of
{- O -}
e =
case {- A -} Just 1 {- B -} of
{- C -}
Just x
{- P -}
{- D -}
->
{- Q -}
{- E -}
x

{- R -}
Expand All @@ -362,24 +377,68 @@ caseStatement =
{- T -}
2

c =
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 -}
rlefevre marked this conversation as resolved.
Show resolved Hide resolved
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
{}