Set proper indentation base level for operands

data/10-structured/expression-list.blt

@@ -21,3 +21,10 @@ foo =
   , 4
   , 5
   ]
+
+#test set-base-y for multiple line elements
+foo =
+  [ aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa
+  , bbbbbbbbbbbbbbbbbb
+    $ cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
+  ]

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

data/15-regressions.blt

@@ -215,13 +215,13 @@ showPackageDetailedInfo pkginfo =
                   (altText null "[ Not available from server ]")
                   (dispTopVersions 9 (preferredVersions pkginfo))
           , entry
-            "Versions installed"
-            installedVersions
-            (altText
-              null
-              (if hasLib pkginfo then "[ Not installed ]" else "[ Unknown ]")
-            )
-            (dispTopVersions 4 (preferredVersions pkginfo))
+              "Versions installed"
+              installedVersions
+              (altText
+                null
+                (if hasLib pkginfo then "[ Not installed ]" else "[ Unknown ]")
+              )
+              (dispTopVersions 4 (preferredVersions pkginfo))
           , entry "Homepage"      homepage     orNotSpecified  text
           , entry "Bug reports"   bugReports   orNotSpecified  text
           , entry "Description"   description  hideIfNull      reflowParagraphs
@@ -236,10 +236,10 @@ showPackageDetailedInfo pkginfo =
           , entry "Documentation" haddockHtml  showIfInstalled text
           , entry "Cached"        haveTarball  alwaysShow      dispYesNo
           , if not (hasLib pkginfo)
-            then empty
-            else
-              text "Modules:"
-              $+$ nest 4 (vcat (map disp . sort . modules $ pkginfo))
+              then empty
+              else
+                text "Modules:"
+                $+$ nest 4 (vcat (map disp . sort . modules $ pkginfo))
           ]
 
 #test issue 7a
@@ -413,10 +413,10 @@ layoutPatternBindFinal alignmentToken binderDoc mPatDoc clauseDocs = do
            (ColBindingLine alignmentToken)
            [ docSeq (patPartInline ++ [guardPart])
            , docSeq
-             [ appSep $ return binderDoc
-             , docForceSingleline $ return body
-             , wherePart
-             ]
+               [ appSep $ return binderDoc
+               , docForceSingleline $ return body
+               , wherePart
+               ]
            ]
        | not hasComments
        , [(guards, body, _bodyRaw)] <- [clauseDocs]
@@ -436,7 +436,7 @@ layoutPatternBindFinal alignmentToken binderDoc mPatDoc clauseDocs = do
                 (ColBindingLine alignmentToken)
                 [ docSeq (patPartInline ++ [guardPart])
                 , docSeq
-                  [appSep $ return binderDoc, docForceParSpacing $ return body]
+                    [appSep $ return binderDoc, docForceParSpacing $ return body]
                 ]
             ]
          ++ wherePartMultiLine
@@ -447,10 +447,10 @@ layoutPatternBindFinal alignmentToken binderDoc mPatDoc clauseDocs = do
     ++ -- two-line solution + where in next line(s)
        [ docLines
          $  [ docForceSingleline $ docSeq
-              (patPartInline ++ [guardPart, return binderDoc])
+                (patPartInline ++ [guardPart, return binderDoc])
             , docEnsureIndent BrIndentRegular
-            $ docForceSingleline
-            $ return body
+              $ docForceSingleline
+              $ return body
             ]
          ++ wherePartMultiLine
        | [(guards, body, _bodyRaw)] <- [clauseDocs]
@@ -1084,9 +1084,20 @@ func = do
   -- but that's a type error.
   let jebnaZiegui = UtatUcaOrgmqf
         $ eqazak
-          (NO.kaeyuo . NO.FUGOKovsxq)
-          (maybe (NO.kaeyuo NO.UvmsoItqOguTOLqtuld)
-                 (NO.kaeyuo . NO.XvswJUBeroci)
-          )
-          nogcVassuVvbFiew
+            (NO.kaeyuo . NO.FUGOKovsxq)
+            (maybe (NO.kaeyuo NO.UvmsoItqOguTOLqtuld)
+                   (NO.kaeyuo . NO.XvswJUBeroci)
+            )
+            nogcVassuVvbFiew
       kyxson = vzahxEooRecOriqdp apneZejuzTfuQkuJosqoa
+
+#test base level for operands
+func = do
+  pure
+    $!! otherFunc
+          (SomeLargeRecord { aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa = 1
+                           , bbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbb = 2
+                           , cccccccccccccccccccccccccccccccccc = 3
+                           }
+          )
+          anotherArgument

data/30-tests-context-free.blt

@@ -1149,18 +1149,18 @@ showPackageDetailedInfo pkginfo =
     $+$ something
           [ entry "Synopsis" synopsis hideIfNull reflowParagraphs
           , entry
-            "Versions available"
-            sourceVersions
-            (altText null "[ Not available from server ]")
-            (dispTopVersions 9 (preferredVersions pkginfo))
+              "Versions available"
+              sourceVersions
+              (altText null "[ Not available from server ]")
+              (dispTopVersions 9 (preferredVersions pkginfo))
           , entry
-            "Versions installed"
-            installedVersions
-            (altText
-              null
-              (if hasLib pkginfo then "[ Not installed ]" else "[ Unknown ]")
-            )
-            (dispTopVersions 4 (preferredVersions pkginfo))
+              "Versions installed"
+              installedVersions
+              (altText
+                null
+                (if hasLib pkginfo then "[ Not installed ]" else "[ Unknown ]")
+              )
+              (dispTopVersions 4 (preferredVersions pkginfo))
           , entry "Homepage" homepage orNotSpecified text
           , entry "Bug reports" bugReports orNotSpecified text
           , entry "Description" description hideIfNull reflowParagraphs
@@ -1175,10 +1175,10 @@ showPackageDetailedInfo pkginfo =
           , entry "Documentation" haddockHtml showIfInstalled text
           , entry "Cached" haveTarball alwaysShow dispYesNo
           , if not (hasLib pkginfo)
-            then empty
-            else
-              text "Modules:"
-              $+$ nest 4 (vcat (map disp . sort . modules $ pkginfo))
+              then empty
+              else
+                text "Modules:"
+                $+$ nest 4 (vcat (map disp . sort . modules $ pkginfo))
           ]
 
 #test issue 7a
@@ -1339,10 +1339,10 @@ layoutPatternBindFinal alignmentToken binderDoc mPatDoc clauseDocs = do
           (ColBindingLine alignmentToken)
           [ docSeq (patPartInline ++ [guardPart])
           , docSeq
-            [ appSep $ return binderDoc
-            , docForceSingleline $ return body
-            , wherePart
-            ]
+              [ appSep $ return binderDoc
+              , docForceSingleline $ return body
+              , wherePart
+              ]
           ]
       | not hasComments
       , [(guards, body, _bodyRaw)] <- [clauseDocs]
@@ -1362,7 +1362,7 @@ layoutPatternBindFinal alignmentToken binderDoc mPatDoc clauseDocs = do
                (ColBindingLine alignmentToken)
                [ docSeq (patPartInline ++ [guardPart])
                , docSeq
-                 [appSep $ return binderDoc, docForceParSpacing $ return body]
+                   [appSep $ return binderDoc, docForceParSpacing $ return body]
                ]
            ]
          ++ wherePartMultiLine
@@ -1373,10 +1373,10 @@ layoutPatternBindFinal alignmentToken binderDoc mPatDoc clauseDocs = do
     ++ -- two-line solution + where in next line(s)
        [ docLines
          $ [ docForceSingleline $ docSeq
-             (patPartInline ++ [guardPart, return binderDoc])
+               (patPartInline ++ [guardPart, return binderDoc])
            , docEnsureIndent BrIndentRegular
-           $ docForceSingleline
-           $ return body
+             $ docForceSingleline
+             $ return body
            ]
          ++ wherePartMultiLine
        | [(guards, body, _bodyRaw)] <- [clauseDocs]

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/Expr.hs

@@ -736,15 +736,15 @@ layoutExpr lexpr@(L _ expr) = do
                , docForceSingleline eN
                , closeDoc]
           addAlternative
-            $ let start  = docCols ColList [appSep $ openDoc, e1]
+            $ let start  = docCols ColList [appSep $ openDoc, docSetBaseY e1]
                   linesM = ems <&> \(p, ast, d) ->
                     docCols
                       ColList
                       [ docHandleComms p docCommaSep
-                      , docFlushCommsPost True ast $ d
+                      , docSetBaseY $ docFlushCommsPost True ast $ d
                       ]
                   lineN  = docCols ColList
-                    [docHandleComms finalCommaPos $ docCommaSep, eN]
+                    [docHandleComms finalCommaPos $ docCommaSep, docSetBaseY eN]
               in  docSetBaseY
                   $  docLines
                   $  [start]

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) ->
@@ -423,7 +425,7 @@ layoutOpTree allowSinglelinePar = \case
         let singlelineUnlessFree = case indentPolicy of
               IndentPolicyLeft     -> docForceSingleline
               IndentPolicyMultiple -> docForceSingleline
-              IndentPolicyFree     -> id
+              IndentPolicyFree     -> docSetBaseY
         let curIsPrec0 = case fixity of
               Nothing                -> False
               Just (Fixity _ prec _) -> prec == 0

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