diff --git a/data/10-structured/op-precedence.blt b/data/10-structured/op-precedence.blt index 4f682b0..1be4855 100644 --- a/data/10-structured/op-precedence.blt +++ b/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 diff --git a/source/library/Language/Haskell/Brittany/Internal/Components/OpTree.hs b/source/library/Language/Haskell/Brittany/Internal/Components/OpTree.hs index 7d43ba1..f0a8084 100644 --- a/source/library/Language/Haskell/Brittany/Internal/Components/OpTree.hs +++ b/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) [] diff --git a/source/library/Language/Haskell/Brittany/Internal/ToBriDoc/OpTree.hs b/source/library/Language/Haskell/Brittany/Internal/ToBriDoc/OpTree.hs index 9475661..45706d2 100644 --- a/source/library/Language/Haskell/Brittany/Internal/ToBriDoc/OpTree.hs +++ b/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) -> diff --git a/source/library/Language/Haskell/Brittany/Internal/ToBriDoc/Type.hs b/source/library/Language/Haskell/Brittany/Internal/ToBriDoc/Type.hs index bf7a426..bcd0688 100644 --- a/source/library/Language/Haskell/Brittany/Internal/ToBriDoc/Type.hs +++ b/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)]) diff --git a/source/library/Language/Haskell/Brittany/Internal/Types.hs b/source/library/Language/Haskell/Brittany/Internal/Types.hs index ae199cf..4c2cea0 100644 --- a/source/library/Language/Haskell/Brittany/Internal/Types.hs +++ b/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