Fix/Implement proper layouting of MultiWayIf

src-literatetests/tests.blt

@@ -391,13 +391,22 @@ func x
   | otherwise                 = "fit without putting the guards in new lines"
 
 #test multiple-clauses-3
+func x
+  | very long guard, another rather long guard that refers to x = nontrivial
+    expression
+    foo
+    bar
+    alsdkjlasdjlasj
+  | otherwise = 0
+
+#test multiple-clauses-4
 func x
   | very long guard, another rather long guard that refers to x
   = nontrivialexpression foo bar alsdkjlasdjlasj
   | otherwise
   = 0
 
-#test multiple-clauses-4
+#test multiple-clauses-5
 func x
   | very loooooooooooooooooooooooooooooong guard
   , another rather long guard that refers to x
@@ -541,6 +550,29 @@ func =
       ]
 
 
+###############################################################################
+###############################################################################
+###############################################################################
+#group expression.multiwayif
+###############################################################################
+###############################################################################
+###############################################################################
+
+#test simple
+{-# LANGUAGE MultiWayIf #-}
+func = if
+  | cond1 -> loooooooooooooooooooooooooooooong expr1
+  | cond2 -> loooooooooooooooooooooooooooooong expr2
+
+#test simplenested
+{-# LANGUAGE MultiWayIf #-}
+func = do
+  foo
+  bar $ if
+    | cond1 -> loooooooooooooooooooooooooooooong expr1
+    | cond2 -> loooooooooooooooooooooooooooooong expr2
+
+
 ###############################################################################
 ###############################################################################
 ###############################################################################
@@ -680,7 +712,7 @@ layoutWriteNewlineBlock
   => m ()
 
 #test multiwayif proper indentation
-#pending "TODO"
+{-# LANGUAGE MultiWayIf #-}
 readMergePersConfig path shouldCreate conf = do
   exists <- liftIO $ System.Directory.doesFileExist path
   if
@@ -690,15 +722,17 @@ readMergePersConfig path shouldCreate conf = do
         Left e -> do
           liftIO
             $  putStrErrLn
-              $ "error reading in brittany config from " ++ path ++ ":"
+            $  "error reading in brittany config from "
+            ++ path
+            ++ ":"
           liftIO $ putStrErrLn e
           mzero
         Right x -> return x
       return $ fileConf Semigroup.<> conf
     | shouldCreate -> do
-        liftIO $ ByteString.writeFile path
+      liftIO $ ByteString.writeFile path $ Data.Yaml.encode $ cMap
-               $ Data.Yaml.encode
+        (Option . Just . runIdentity)
-               $ cMap (Option . Just . runIdentity) staticDefaultConfig
+        staticDefaultConfig
       return $ conf
     | otherwise -> do
       return conf
@@ -854,7 +888,7 @@ func =
     + foooooooooooooooooooooooooooooooo foooooooooooooooooooooooooooooooo
                                         foooooooooooooooooooooooooooooooo
 
-#test opapp-specialcasing-2
+#test opapp-specialcasing-3
 func = fooooooooooooooooooooooooooooooooo + foooooooooooooooooooooooooooooooo
   [ foooooooooooooooooooooooooooooooo
   , foooooooooooooooooooooooooooooooo

src/Language/Haskell/Brittany/Internal/Layouters/Decl.hs

@@ -324,7 +324,7 @@ layoutPatternBindFinal alignmentToken binderDoc mPatDoc clauseDocs mWhereDocs ha
        ]
     ++ -- pattern and exactly one clause in single line, body in new line.
        [ docLines
-         $  [ docSeq (patPartInline ++ [appSep $ guardPart, return binderDoc])
+         $  [ docSeq (patPartInline ++ [guardPart, return binderDoc])
             , docEnsureIndent BrIndentRegular
             $ docNonBottomSpacing
             $ (docAddBaseY BrIndentRegular $ return body)
@@ -364,9 +364,10 @@ layoutPatternBindFinal alignmentToken binderDoc mPatDoc clauseDocs mWhereDocs ha
        ]
     ++ -- multiple clauses, each in a separate, single line
        [ docLines
-         $  [ patPartParWrap
+         $  [ docAddBaseY BrIndentRegular
-              $   docEnsureIndent BrIndentRegular
+              $   patPartParWrap
               $   docLines
+              $   map docSetBaseY
               $   clauseDocs
               <&> \(guardDocs, bodyDoc, _) -> do
                     let guardPart = singleLineGuardsDoc guardDocs
@@ -389,9 +390,45 @@ layoutPatternBindFinal alignmentToken binderDoc mPatDoc clauseDocs mWhereDocs ha
     ++ -- multiple clauses, each with the guard(s) in a single line, body
        -- as a paragraph
        [ docLines
-         $  [ patPartParWrap
+         $  [ docAddBaseY BrIndentRegular
-              $   docEnsureIndent BrIndentRegular
+              $   patPartParWrap
               $   docLines
+              $   map docSetBaseY
+              $   clauseDocs
+              <&> \(guardDocs, bodyDoc, _) ->
+                    docSeq
+                    $ ( case guardDocs of
+                        [] -> []
+                        [g] ->
+                          [ docForceSingleline
+                          $ docSeq [appSep $ docLit $ Text.pack "|", return g]
+                          ]
+                        gs ->
+                          [  docForceSingleline
+                          $  docSeq
+                          $  [appSep $ docLit $ Text.pack "|"]
+                          ++ List.intersperse docCommaSep (return <$> gs)
+                          ]
+                      )
+                      ++ [ docSeparator
+                         , docCols
+                           ColOpPrefix
+                           [ appSep $ return binderDoc
+                           , docAddBaseY BrIndentRegular
+                           $ docForceParSpacing
+                           $ return bodyDoc
+                           ]
+                         ]
+            ]
+         ++ wherePartMultiLine
+       ]
+    ++ -- multiple clauses, each with the guard(s) in a single line, body
+       -- in a new line as a paragraph
+       [ docLines
+         $  [ docAddBaseY BrIndentRegular
+              $   patPartParWrap
+              $   docLines
+              $   map docSetBaseY
               $   clauseDocs
               >>= \(guardDocs, bodyDoc, _) ->
                     ( case guardDocs of
@@ -410,8 +447,8 @@ layoutPatternBindFinal alignmentToken binderDoc mPatDoc clauseDocs mWhereDocs ha
                     ++ [ docCols
                          ColOpPrefix
                          [ appSep $ return binderDoc
-                           , docForceParSpacing
+                         , docAddBaseY BrIndentRegular
-                           $ docAddBaseY BrIndentRegular
+                         $ docForceParSpacing
                          $ return bodyDoc
                          ]
                        ]
@@ -420,9 +457,10 @@ layoutPatternBindFinal alignmentToken binderDoc mPatDoc clauseDocs mWhereDocs ha
        ]
     ++ -- conservative approach: everything starts on the left.
        [ docLines
-         $  [ patPartParWrap
+         $  [ docAddBaseY BrIndentRegular
-              $   docEnsureIndent BrIndentRegular
+              $   patPartParWrap
               $   docLines
+              $   map docSetBaseY
               $   clauseDocs
               >>= \(guardDocs, bodyDoc, _) ->
                     ( case guardDocs of

src/Language/Haskell/Brittany/Internal/Layouters/Expr.hs

@@ -475,7 +475,7 @@ layoutExpr lexpr@(L _ expr) = docWrapNode lexpr $ case expr of
     clauseDocs <- cases `forM` layoutGrhs
     binderDoc <- docLit $ Text.pack "->"
     hasComments <- hasAnyCommentsBelow lexpr
-    docAddBaseY BrIndentRegular $ docPar
+    docSetParSpacing $ docAddBaseY BrIndentRegular $ docPar
       (docLit $ Text.pack "if")
       (layoutPatternBindFinal Nothing binderDoc Nothing clauseDocs Nothing hasComments)
   HsLet binds exp1 -> do