Skip to content

Commit 1f2108c

Browse files
rlefevrerlefevre
committed
Allow single-line case-expressions branches
Resolves #507
1 parent 3b2a0fd commit 1f2108c

File tree

7 files changed

+124
-83
lines changed

7 files changed

+124
-83
lines changed

‎parser/src/AST/Expression.hs‎

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -61,7 +61,7 @@ data Expr'
6161
| Lambda [(Comments, Pattern.Pattern)] Comments Expr Bool
6262
| If IfClause [(Comments, IfClause)] (Comments, Expr)
6363
| Let [LetDeclaration] Comments Expr
64-
| Case (Commented Expr, Bool) [(Commented Pattern.Pattern, (Comments, Expr))]
64+
| Case (Commented Expr, Multiline) [(Commented Pattern.Pattern, (Comments, Expr), Multiline)]
6565

6666
-- for type checking and code gen only
6767
| GLShader String

‎parser/src/AST/Json.hs‎

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -406,7 +406,7 @@ instance ToJSON Expr where
406406
, ( "subject", showJSON subject )
407407
, ( "branches"
408408
, JSArray $ map
409-
(\(Commented _ (A _ pat) _, (_, body)) ->
409+
(\(Commented _ (A _ pat) _, (_, body), _) ->
410410
makeObj
411411
[ ("pattern", showJSON pat)
412412
, ("body", showJSON body)

‎parser/src/Parse/Expression.hs‎

Lines changed: 10 additions & 8 deletions
Original file line numberDiff line numberDiff line change
@@ -234,21 +234,23 @@ caseExpr elmVersion =
234234
(e, multilineSubject) <- trackNewline $ (\(pre, e, post) -> Commented pre e post) <$> padded (expr elmVersion)
235235
reserved elmVersion "of"
236236
firstPatternComments <- whitespace
237-
result <- cases firstPatternComments
238-
return $ E.Case (e, multilineToBool multilineSubject) result
237+
branches <- cases firstPatternComments
238+
return $ E.Case (e, multilineSubject) branches
239239
where
240240
case_ preComments =
241241
do
242-
(patternComments, p, (preArrowComments, _, bodyComments)) <-
243-
try ((,,)
242+
(patternComments, (p, multi), ((preArrowComments, _, bodyComments), multi')) <-
243+
try $ (,,)
244244
<$> whitespace
245-
<*> (checkIndent >> Pattern.expr elmVersion)
246-
<*> padded rightArrow
247-
)
248-
result <- expr elmVersion
245+
<*> trackNewline (checkIndent >> Pattern.expr elmVersion)
246+
<*> trackNewline (padded rightArrow)
247+
(result, multi'') <- trackNewline $ expr elmVersion
249248
return
250249
( Commented (preComments ++ patternComments) p preArrowComments
251250
, (bodyComments, result)
251+
, case (multi, multi', multi'') of
252+
(JoinAll, JoinAll, JoinAll) -> JoinAll
253+
_ -> SplitAll
252254
)
253255

254256
cases preComments =

‎src/AST/MapExpr.hs‎

Lines changed: 5 additions & 5 deletions
Original file line numberDiff line numberDiff line change
@@ -32,12 +32,12 @@ instance MapExpr a => MapExpr [a] where
3232
mapExpr f list = fmap (mapExpr f) list
3333

3434

35-
instance MapExpr a => MapExpr (a, Bool) where
36-
mapExpr f (a, b) = (mapExpr f a, b)
35+
instance MapExpr a => MapExpr (a, Multiline) where
36+
mapExpr f (a, multi) = (mapExpr f a, multi)
3737

3838

39-
instance MapExpr a => MapExpr (Commented Pattern, a) where
40-
mapExpr f (x, a) = (x, mapExpr f a)
39+
instance MapExpr a => MapExpr (Commented Pattern, a, Multiline) where
40+
mapExpr f (x, a, multi) = (x, mapExpr f a, multi)
4141

4242

4343
instance MapExpr a => MapExpr (Comments, Ref, Comments, a) where
@@ -85,7 +85,7 @@ instance MapExpr Expr' where
8585
If (mapExpr f c1) (mapExpr f elseIfs) (mapExpr f els)
8686
Let decls pre body ->
8787
Let (mapExpr f decls) pre body
88-
Case cond branches ->
88+
Case cond branches ->
8989
Case (mapExpr f cond) (mapExpr f branches)
9090
GLShader _ -> expr
9191

‎src/ElmFormat/Render/Box.hs‎

Lines changed: 90 additions & 61 deletions
Original file line numberDiff line numberDiff line change
@@ -1284,8 +1284,8 @@ formatPair formatA delim formatB (AST.Pair a b (AST.ForceMultiline forceMultilin
12841284
(formatHeadCommented formatB b)
12851285

12861286

1287-
negativeCasePatternWorkaround :: AST.Commented AST.Pattern.Pattern -> Box -> Box
1288-
negativeCasePatternWorkaround (AST.Commented _ (RA.A _ pattern) _) =
1287+
negativeCasePatternWorkaround :: AST.Pattern.Pattern -> Box -> Box
1288+
negativeCasePatternWorkaround (RA.A _ pattern) =
12891289
case pattern of
12901290
AST.Pattern.Literal (AST.IntNum i _) | i < 0 -> parens
12911291
AST.Pattern.Literal (AST.FloatNum f _) | f < 0 -> parens
@@ -1493,65 +1493,9 @@ formatExpression' elmVersion importInfo context aexpr =
14931493
]
14941494
|> expressionParens AmbiguousEnd context -- TODO: not tested
14951495

1496-
AST.Expression.Case (subject,multiline) clauses ->
1497-
let
1498-
opening =
1499-
case
1500-
( multiline
1501-
, formatCommentedExpression elmVersion importInfo SyntaxSeparated subject
1502-
)
1503-
of
1504-
(False, SingleLine subject') ->
1505-
line $ row
1506-
[ keyword "case"
1507-
, space
1508-
, subject'
1509-
, space
1510-
, keyword "of"
1511-
]
1512-
(_, subject') ->
1513-
stack1
1514-
[ line $ keyword "case"
1515-
, indent subject'
1516-
, line $ keyword "of"
1517-
]
1518-
1519-
clause (pat, expr) =
1520-
case
1521-
( pat
1522-
, (formatPattern elmVersion False $ (\(AST.Commented _ x _) -> x) pat)
1523-
|> negativeCasePatternWorkaround pat
1524-
, formatCommentedStack (formatPattern elmVersion False) pat
1525-
|> negativeCasePatternWorkaround pat
1526-
, formatHeadCommentedStack (formatExpression elmVersion importInfo SyntaxSeparated) expr
1527-
)
1528-
of
1529-
(_, _, SingleLine pat', body') ->
1530-
stack1
1531-
[ line $ row [ pat', space, keyword "->"]
1532-
, indent body'
1533-
]
1534-
(AST.Commented pre _ [], SingleLine pat', _, body') ->
1535-
stack1 $
1536-
(map formatComment pre)
1537-
++ [ line $ row [ pat', space, keyword "->"]
1538-
, indent body'
1539-
]
1540-
(_, _, pat', body') ->
1541-
stack1 $
1542-
[ pat'
1543-
, line $ keyword "->"
1544-
, indent body'
1545-
]
1546-
in
1547-
opening
1548-
|> andThen
1549-
(clauses
1550-
|> map clause
1551-
|> List.intersperse blankLine
1552-
|> map indent
1553-
)
1554-
|> expressionParens AmbiguousEnd context -- TODO: not tested
1496+
AST.Expression.Case subject branches ->
1497+
formatCaseExpression elmVersion importInfo subject branches
1498+
|> expressionParens AmbiguousEnd context -- TODO: not tested
15551499

15561500
AST.Expression.Tuple exprs multiline ->
15571501
ElmStructure.group True "(" "," ")" multiline $ map (formatCommentedExpression elmVersion importInfo SyntaxSeparated) exprs
@@ -1595,6 +1539,91 @@ formatExpression' elmVersion importInfo context aexpr =
15951539
]
15961540

15971541

1542+
formatCaseExpression ::
1543+
ElmVersion
1544+
-> ImportInfo
1545+
-> (AST.Commented AST.Expression.Expr, AST.Multiline)
1546+
-> [(AST.Commented AST.Pattern.Pattern, (AST.Comments, AST.Expression.Expr), AST.Multiline)]
1547+
-> Box
1548+
formatCaseExpression elmVersion importInfo subject branches =
1549+
let
1550+
branchBoxes multilineAcc (AST.Commented prePat pat postPat, (preBody, body), multilineBranch) =
1551+
let
1552+
(prePat', pat', postPat') =
1553+
( Maybe.maybeToList $ formatComments prePat
1554+
, formatPattern elmVersion False pat |> negativeCasePatternWorkaround pat
1555+
, Maybe.maybeToList $ formatComments postPat
1556+
)
1557+
(preBody', body') =
1558+
( Maybe.maybeToList $ formatComments preBody
1559+
, formatExpression elmVersion importInfo SyntaxSeparated body
1560+
)
1561+
(singlesPat, singlesBody) =
1562+
( allSingles $ concat [ prePat', [pat'], postPat']
1563+
, allSingles $ concat [ preBody', [body']]
1564+
)
1565+
in
1566+
case (multilineBranch, singlesPat, singlesBody) of
1567+
(AST.JoinAll, Right patLines, Right bodyLines) ->
1568+
(multilineAcc, Right (patLines, bodyLines))
1569+
_ ->
1570+
(AST.SplitAll, Left (prePat', pat', postPat', preBody', body'))
1571+
1572+
(multilineBranches, branches') =
1573+
List.mapAccumR branchBoxes AST.JoinAll branches
1574+
1575+
branch multiline' boxes =
1576+
case (multiline', boxes) of
1577+
(AST.JoinAll, Right (patLines, bodyLines)) ->
1578+
line $ row $ List.intersperse space $ patLines ++ [keyword "->"] ++ bodyLines
1579+
(AST.SplitAll, Right (patLines, bodyLines)) ->
1580+
stack1
1581+
[ line $ row $ List.intersperse space $ patLines ++ [keyword "->"]
1582+
, indent $ line $ row $ bodyLines
1583+
]
1584+
(_, Left ([], SingleLine pat, [], preBody, body)) ->
1585+
stack1
1586+
[ line $ row [pat, space, keyword "->"]
1587+
, indent $ stack1 $ preBody ++ [body]
1588+
]
1589+
(_, Left (prePat, SingleLine pat', [], preBody, body)) ->
1590+
stack1
1591+
[ stack1 prePat
1592+
, line $ row [pat', space, keyword "->"]
1593+
, indent $ stack1 $ preBody ++ [body]
1594+
]
1595+
(_, Left (prePat, pat, postPat, preBody, body)) ->
1596+
stack1
1597+
[ stack1 $ prePat ++ [pat] ++ postPat
1598+
, line $ keyword "->"
1599+
, indent $ stack1 $ preBody ++ [body]
1600+
]
1601+
in
1602+
formatCaseExpressionOpening elmVersion importInfo subject
1603+
|> andThen
1604+
(branches'
1605+
|> map (branch multilineBranches)
1606+
|> (if AST.isMultiline multilineBranches then List.intersperse blankLine else id)
1607+
|> map indent
1608+
)
1609+
1610+
formatCaseExpressionOpening :: ElmVersion -> ImportInfo -> (AST.Commented AST.Expression.Expr, AST.Multiline) -> Box
1611+
formatCaseExpressionOpening elmVersion importInfo (subject, multiline) =
1612+
case
1613+
( multiline
1614+
, formatCommentedExpression elmVersion importInfo SyntaxSeparated subject
1615+
)
1616+
of
1617+
(AST.JoinAll, SingleLine subject') ->
1618+
line $ row [ keyword "case" , space , subject' , space , keyword "of" ]
1619+
(_, subject') ->
1620+
stack1
1621+
[ line $ keyword "case"
1622+
, indent subject'
1623+
, line $ keyword "of"
1624+
]
1625+
1626+
15981627
formatCommentedExpression :: ElmVersion -> ImportInfo -> ExpressionContext -> AST.Commented AST.Expression.Expr -> Box
15991628
formatCommentedExpression elmVersion importInfo context (AST.Commented pre e post) =
16001629
let

‎tests/Parse/ExpressionTest.hs‎

Lines changed: 5 additions & 5 deletions
Original file line numberDiff line numberDiff line change
@@ -282,11 +282,11 @@ tests =
282282
]
283283

284284
, testGroup "case statement"
285-
[ 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))))])
286-
, 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))))])
287-
, 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))))])
288-
, 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))))])
289-
, 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))))])
285+
[ 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)])
286+
, 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)])
287+
, 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)])
288+
, 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)])
289+
, 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)])
290290
, testCase "should not consume trailing whitespace" $
291291
assertParse (expr Elm_0_19>> string "\nX") "case 9 of\n 1->10\n _->20\nX" $ "\nX"
292292
, testGroup "clauses must start at the same column"

‎tests/test-files/good/Elm-0.19/AllSyntax/Expressions.elm‎

Lines changed: 12 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -339,14 +339,24 @@ letStatement =
339339
caseStatement =
340340
let
341341
a =
342+
case Just 1 of
343+
Just x -> x
344+
_ -> 2
345+
346+
b =
347+
case {- A -} Just 1 {- B -} of
348+
Just x {- C -} -> {- D -} x
349+
_ {- E -} -> {- F -} 2
350+
351+
c =
342352
case Just 1 of
343353
Just x ->
344354
x
345355

346356
_ ->
347357
2
348358

349-
b =
359+
d =
350360
case {- M -} Just 1 {- N -} of
351361
{- O -}
352362
Just x
@@ -362,7 +372,7 @@ caseStatement =
362372
{- T -}
363373
2
364374

365-
c =
375+
e =
366376
case
367377
--M
368378
Just 1

0 commit comments

Comments
 (0)