Allow single-line case-expressions branches

This implementation uses only the first case branch to decide if single-line branches is wanted.
This allows to easily go from multi-line to single-line, even with lots of branches.

Closes #507

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, Bool) [(Commented Pattern.Pattern, (Comments, Expr))] Bool
 
     -- for type checking and code gen only
     | GLShader String

parser/src/AST/Json.hs

@@ -400,7 +400,7 @@ instance ToJSON Expr where
                   , ("body", showJSON body)
                   ]
 
-          Case (Commented _ subject _, _) branches ->
+          Case (Commented _ subject _, _) branches _ ->
               makeObj
                   [ type_ "CaseExpression"
                   , ( "subject", showJSON subject )

parser/src/Parse/Expression.hs

@@ -234,8 +234,8 @@ 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
+      (result, multiline) <- cases firstPatternComments
+      return $ E.Case (e, multilineToBool multilineSubject) result (multilineToBool multiline)
   where
     case_ preComments =
       do
@@ -254,9 +254,9 @@ caseExpr elmVersion =
     cases preComments =
         withPos $
             do
-                r1 <- case_ preComments
+                (r1, multiline) <- trackNewline (case_ preComments)
                 r <- many $ case_ []
-                return $ r1:r
+                return (r1:r, multiline)
 
 
 

src/AST/MapExpr.hs

@@ -85,8 +85,8 @@ 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 (mapExpr f cond) (mapExpr f branches)
+        Case cond branches multiline ->
+            Case (mapExpr f cond) (mapExpr f branches) multiline
         GLShader _ -> expr
 
 

src/ElmFormat/Render/Box.hs

@@ -16,6 +16,7 @@ import qualified AST.Variable
 import qualified Cheapskate.Types as Markdown
 import qualified Control.Monad as Monad
 import qualified Data.Char as Char
+import qualified Data.Either as Either
 import qualified Data.Foldable as Foldable
 import qualified Data.List as List
 import qualified Data.Map.Strict as Map
@@ -1493,51 +1494,57 @@ formatExpression' elmVersion importInfo context aexpr =
                         ]
                     |> expressionParens AmbiguousEnd context -- TODO: not tested
 
-        AST.Expression.Case (subject,multiline) clauses ->
+        AST.Expression.Case (subject, multilineSubject) clauses multilineClauses ->
             let
                 opening =
                   case
-                    ( multiline
+                    ( multilineSubject
                     , formatCommentedExpression elmVersion importInfo SyntaxSeparated subject
                     )
                   of
                       (False, SingleLine subject') ->
-                          line $ row
-                              [ keyword "case"
-                              , space
-                              , subject'
-                              , space
-                              , keyword "of"
-                              ]
+                          line $ row [ keyword "case" , space , subject' , space , keyword "of" ]
                       (_, subject') ->
                           stack1
                               [ line $ keyword "case"
                               , indent subject'
                               , line $ keyword "of"
                               ]
 
-                clause (pat, expr) =
+                clausesBodies =
+                    map (formatHeadCommentedStack (formatExpression elmVersion importInfo SyntaxSeparated) . snd) clauses
+
+                splitAllClauses =
+                    List.foldl'
+                        (\mline box -> if Either.isRight (Box.isLine box) then mline else True)
+                        multilineClauses
+                        clausesBodies
+
+                clause multiline ((pat, _), body) =
                     case
-                      ( pat
+                      ( multiline
+                      , pat
                       , (formatPattern elmVersion False $ (\(AST.Commented _ x _) -> x) pat)
                           |> negativeCasePatternWorkaround pat
                       , formatCommentedStack (formatPattern elmVersion False) pat
                           |> negativeCasePatternWorkaround pat
-                      , formatHeadCommentedStack (formatExpression elmVersion importInfo SyntaxSeparated) expr
+                      , body
                       )
                     of
-                        (_, _, SingleLine pat', body') ->
+                        (False, _, _, SingleLine pat', SingleLine body') ->
+                            line $ row [pat', space, keyword "->", space, body']
+                        (_, _, _, SingleLine pat', body') ->
                             stack1
                                 [ line $ row [ pat', space, keyword "->"]
                                 , indent body'
                                 ]
-                        (AST.Commented pre _ [], SingleLine pat', _, body') ->
+                        (_, AST.Commented pre _ [], SingleLine pat', _, body') ->
                             stack1 $
                                 (map formatComment pre)
                                 ++ [ line $ row [ pat', space, keyword "->"]
                                    , indent body'
                                    ]
-                        (_, _, pat', body') ->
+                        (_, _, _, pat', body') ->
                             stack1 $
                               [ pat'
                               , line $ keyword "->"
@@ -1546,9 +1553,9 @@ formatExpression' elmVersion importInfo context aexpr =
             in
                 opening
                     |> andThen
-                        (clauses
-                            |> map clause
-                            |> List.intersperse blankLine
+                        (zip clauses clausesBodies
+                            |> map (clause splitAllClauses)
+                            |> (if splitAllClauses then List.intersperse blankLine else id)
                             |> map indent
                         )
                     |> expressionParens AmbiguousEnd context -- TODO: not tested

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))) [],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))))] False)
+        , 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))))] False)
+        , 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))))] False)
+        , 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))))] False)
+        , 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))))] True)
         , 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"