Allow parspacing for lambdacase after operator

data/10-structured/op-precedence.blt

@@ -241,3 +241,9 @@ func = do
       **~ cccccccccccccccccccccccccccccccccccccccccccccccccc
       )
     == 13
+
+#test allow lambdacase parspacing after operator
+foo = do
+  abc `forM_` \case
+    True  -> 1
+    False -> 0

source/library/Language/Haskell/Brittany/Internal/Components/OpTree.hs

@@ -45,7 +45,7 @@ displayOpTree = \case
     ++ ")"
     ++ join [ (showOp op ++ "(" ++ displayOpTree t ++ ")") | (op, t) <- ops ]
     )
-  OpLeaf (x, _) -> show x
+  OpLeaf _ (x, _) -> show x
  where
   showOp :: BriDocNumbered -> String
   showOp = \case
@@ -185,7 +185,7 @@ addAllParens topLevelParen = \case
 remSuperfluousParens :: Int -> OpTree -> OpTree
 remSuperfluousParens outerFixity = \case
   x@OpLeaf{} -> x
-  OpUnknown _ locO locC c@(OpLeaf doc) [] | isLit doc ->
+  OpUnknown _ locO locC c@(OpLeaf _ doc) [] | isLit doc ->
     OpUnknown NoParen locO locC c []
   OpUnknown _ locO locC c@(OpUnknown ParenWithSpace _ _ _ _) [] ->
     OpUnknown NoParen locO locC (remSuperfluousParens 11 c) []

source/library/Language/Haskell/Brittany/Internal/ToBriDoc/OpTree.hs

@@ -7,6 +7,7 @@ import           GHC                            ( GenLocated(L) )
 import           GHC.Hs
 import           GHC.Types.Fixity               ( Fixity(Fixity) )
 import qualified GHC.Types.SrcLoc              as GHC
+import qualified GHC.OldList                   as List
 
 import           Language.Haskell.Brittany.Internal.Components.BriDoc
 import           Language.Haskell.Brittany.Internal.Components.OpTree
@@ -17,6 +18,13 @@ import           Language.Haskell.Brittany.Internal.Types
 import           Language.Haskell.Brittany.Internal.Utils
 
 
+allowAsOpPar :: LHsExpr GhcPs -> Bool
+allowAsOpPar = \case
+  L _ HsLam{}     -> True
+  L _ HsLamCase{} -> True
+  L _ HsDo{}      -> True
+  _               -> False
+
 gatherOpTreeE
   :: OpParenMode
   -> Bool
@@ -39,7 +47,7 @@ gatherOpTreeE hasParen hasComms commWrap locOpen locClose opExprList = \case
       locOpen
       locClose
       ( ( docHandleComms epAnn $ callLayouter layout_expr op1
-        , OpLeaf inner
+        , OpLeaf (allowAsOpPar r1) inner
         )
       : opExprList
       )
@@ -72,25 +80,21 @@ gatherOpTreeE hasParen hasComms commWrap locOpen locClose opExprList = \case
     -- if null opExprList
     --   then pure (innerTree, innerHasComms)
     --   else do
-    numberedRights <-
-      opExprList
-      `forM` \(x, y) -> do
-               x' <- x
-               pure (x', y)
+    numberedRights <- opExprList `forM` \(x, y) -> do
+      x' <- x
+      pure (x', y)
     pure
       $ ( OpUnknown hasParen locOpen locClose innerTree numberedRights
         , innerHasComms
         )
   final | hasParen == NoParen && null opExprList -> do
     tree <- commWrap $ callLayouter layout_expr final
-    pure (OpLeaf tree, hasComms)
+    pure (OpLeaf (allowAsOpPar final) tree, hasComms)
   final@(L _ inner) -> do
     numberedLeft   <- commWrap $ callLayouter layout_expr final
-    numberedRights <-
-      opExprList
-      `forM` \(x, y) -> do
-               x' <- x
-               pure (x', y)
+    numberedRights <- opExprList `forM` \(x, y) -> do
+      x' <- x
+      pure (x', y)
     pure
       $ ( OpUnknown
             (case (hasParen, inner) of
@@ -100,7 +104,7 @@ gatherOpTreeE hasParen hasComms commWrap locOpen locClose opExprList = \case
             )
             locOpen
             locClose
-            (OpLeaf $ numberedLeft)
+            (OpLeaf (allowAsOpPar final) numberedLeft)
             numberedRights
         , hasComms
         )
@@ -126,17 +130,13 @@ gatherOpTreeT hasParen hasComms commWrap locOpen locClose opExprList = \case
       commWrap
       locOpen
       locClose
-      ( (docLit $ printRdrNameWithAnns op1, OpLeaf inner)
-      : opExprList
-      )
+      ((docLit $ printRdrNameWithAnns op1, OpLeaf False inner) : opExprList)
       l1
   final@(L _ inner) -> do
     numberedLeft   <- commWrap $ callLayouter2 layout_type False final
-    numberedRights <-
-      opExprList
-      `forM` \(x, y) -> do
-               x' <- x
-               pure (x', y)
+    numberedRights <- opExprList `forM` \(x, y) -> do
+      x' <- x
+      pure (x', y)
     pure
       $ ( OpUnknown
             (case (hasParen, inner) of
@@ -146,7 +146,7 @@ gatherOpTreeT hasParen hasComms commWrap locOpen locClose opExprList = \case
             )
             locOpen
             locClose
-            (OpLeaf $ numberedLeft)
+            (OpLeaf False numberedLeft)
             numberedRights
         , hasComms
         )
@@ -238,7 +238,9 @@ layoutOpTree allowSinglelinePar = \case
     sharedOps     <- simpleTransform docOps
     let lastWrap = if getPrec fixity <= 1
           then docForceParSpacing
-          else docForceSingleline
+          else case List.last docOps of
+            (_, OpLeaf True _) -> docForceParSpacing
+            _                  -> docForceSingleline
     coreAlternative hasParen
                     locO
                     locC
@@ -247,7 +249,7 @@ layoutOpTree allowSinglelinePar = \case
                     sharedOps
                     sharedOpsFlat
                     lastWrap
-  OpLeaf l -> pure l
+  OpLeaf _ l -> pure l
  where
   isPrec0 x = getPrec x == 0
   getPrec = \case
@@ -314,7 +316,7 @@ layoutOpTree allowSinglelinePar = \case
       ]
   coreAlternative hasParen locO locC fixity treeL sharedOps sharedOpsFlat lastWrap
     = do
-      docL <- shareDoc $ layoutOpTree True treeL
+      docL         <- shareDoc $ layoutOpTree True treeL
       indentPolicy <- askLayoutConf _lconfig_indentPolicy
       let zeroOps       = null sharedOps
           spaceAfterPar = not zeroOps
@@ -338,14 +340,14 @@ layoutOpTree allowSinglelinePar = \case
             ParenNoSpace   -> wrapParenMl False innerHead innerLines
           wrapParenMl space innerHead innerLines = docAlt
             [ docForceZeroAdd $ docSetBaseY $ docLines
-              ( [ docCols
-                    ColOpPrefix
-                    [ (if spaceAfterPar || space then appSep else id)
-                    $ docLit
-                    $ Text.pack "("
-                    , docHandleComms locO $ innerHead
-                    ]
-                ]
+              (  [ docCols
+                     ColOpPrefix
+                     [ (if spaceAfterPar || space then appSep else id)
+                     $ docLit
+                     $ Text.pack "("
+                     , docHandleComms locO $ innerHead
+                     ]
+                 ]
               ++ innerLines
               ++ [docHandleComms locC $ docLit $ Text.pack ")"]
               )
@@ -382,7 +384,7 @@ layoutOpTree allowSinglelinePar = \case
           $ wrapParenIfSl hasParen
           $ docSetParSpacing
           $ docSeq
-              ( [docForceSingleline docL]
+              (  [docForceSingleline docL]
               ++ case splitFirstLast sharedOpsFlat of
                    FirstLastEmpty -> []
                    FirstLastSingleton (od, ed) ->

source/library/Language/Haskell/Brittany/Internal/ToBriDoc/Type.hs

@@ -75,7 +75,7 @@ splitArrowType ltype@(L _ typ) = case typ of
             docPar open $ docLines $ list ++ [close]
         ]
     arrowDoc <- docLitS "=>"
-    pure (OpLeaf outerHead, (arrowDoc, innerHead) : innerBody)
+    pure (OpLeaf False outerHead, (arrowDoc, innerHead) : innerBody)
   HsFunTy epAnn _ typ1 typ2 -> do
     (typ1Doc, (innerHead, innerBody)) <- do
       let
@@ -97,7 +97,7 @@ splitArrowType ltype@(L _ typ) = case typ of
       typ2Tuple <- splitArrowType typ2
       pure (typ1Doc, typ2Tuple)
     arrowDoc <- docLitS "->"
-    pure $ (OpLeaf typ1Doc, (arrowDoc, innerHead) : innerBody)
+    pure $ (OpLeaf False typ1Doc, (arrowDoc, innerHead) : innerBody)
   HsParTy epAnn inner -> do
     let AnnParen _ spanOpen spanClose = anns epAnn
     (headPart, restParts) <- splitArrowType inner
@@ -115,7 +115,7 @@ splitArrowType ltype@(L _ typ) = case typ of
     pure $ (OpUnknown NoParen Nothing Nothing innerHead innerRest, [])
   _ -> do
     inner <- layoutType False ltype
-    pure (OpLeaf inner, [])
+    pure (OpLeaf False inner, [])
 
 splitOpType :: LHsType GhcPs -> ToBriDocM (OpTree, [(BriDocNumbered, OpTree)])
 splitOpType = \case
@@ -123,10 +123,10 @@ splitOpType = \case
     docL <- layoutType False l1
     docOp <- docHandleComms pos $ docLit $ printRdrNameWithAnns op1
     (innerHead, innerBody) <- splitOpType r1
-    pure $ (OpLeaf docL, (docOp, innerHead) : innerBody)
+    pure $ (OpLeaf False docL, (docOp, innerHead) : innerBody)
   ltype -> do
     inner <- layoutType False ltype
-    pure (OpLeaf inner, [])
+    pure (OpLeaf False inner, [])
 
 
 splitHsForallTypeFromBinders
@@ -159,7 +159,7 @@ splitHsForallTypeFromBinders binders typ = do
         )
       ]
   dotDoc <- docLitS "."
-  pure (OpLeaf outerHead, (dotDoc, innerHead) : innerBody)
+  pure (OpLeaf False outerHead, (dotDoc, innerHead) : innerBody)
 
 layoutSplitArrowType
   :: (OpTree, [(BriDocNumbered, OpTree)])

source/library/Language/Haskell/Brittany/Internal/Types.hs

@@ -178,7 +178,7 @@ data OpTree
             GHC.Fixity   -- only Just after (successful!) lookup phase
             OpTree
             [(BriDocNumbered, OpTree)]
-  | OpLeaf BriDocNumbered
+  | OpLeaf Bool BriDocNumbered -- bool determines if parspacing is preferred
 
 data SortItemsFlag = ShouldSortItems | KeepItemsUnsorted