Discard special case for non-nested OpApp

data/15-regressions.blt

@@ -237,7 +237,8 @@ showPackageDetailedInfo pkginfo =
           , entry "Cached"        haveTarball  alwaysShow      dispYesNo
           , if not (hasLib pkginfo)
             then empty
-            else text "Modules:"
+            else
+              text "Modules:"
               $+$ nest 4 (vcat (map disp . sort . modules $ pkginfo))
           ]
 
@@ -445,8 +446,8 @@ layoutPatternBindFinal alignmentToken binderDoc mPatDoc clauseDocs = do
        ]
     ++ -- two-line solution + where in next line(s)
        [ docLines
-         $  [ docForceSingleline
+         $  [ docForceSingleline $ docSeq
-              $ docSeq (patPartInline ++ [guardPart, return binderDoc])
+              (patPartInline ++ [guardPart, return binderDoc])
             , docEnsureIndent BrIndentRegular
             $ docForceSingleline
             $ return body
@@ -872,6 +873,7 @@ instance HasDependencies SomeDataModel where
     = (SomeOtherDataModelId, SomeOtherOtherDataModelId)
 
 #test stupid-do-operator-combination
+#pending
 
 func =
   do

data/30-tests-context-free.blt

@@ -1176,7 +1176,8 @@ showPackageDetailedInfo pkginfo =
           , entry "Cached" haveTarball alwaysShow dispYesNo
           , if not (hasLib pkginfo)
             then empty
-            else text "Modules:"
+            else
+              text "Modules:"
               $+$ nest 4 (vcat (map disp . sort . modules $ pkginfo))
           ]
 
@@ -1370,8 +1371,8 @@ layoutPatternBindFinal alignmentToken binderDoc mPatDoc clauseDocs = do
        ]
     ++ -- two-line solution + where in next line(s)
        [ docLines
-         $ [ docForceSingleline
+         $ [ docForceSingleline $ docSeq
-             $ docSeq (patPartInline ++ [guardPart, return binderDoc])
+             (patPartInline ++ [guardPart, return binderDoc])
            , docEnsureIndent BrIndentRegular
            $ docForceSingleline
            $ return body

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

@@ -223,7 +223,9 @@ hardcodedFixity allowUnqualify = \case
   "!"         -> Just $ Fixity NoSourceText 9 InfixL
   "//"        -> Just $ Fixity NoSourceText 9 InfixL
   "<>"        -> Just $ Fixity NoSourceText 6 InfixR
+  "<+>"       -> Just $ Fixity NoSourceText 5 InfixR
   "<$"        -> Just $ Fixity NoSourceText 4 InfixL
+  "$>"        -> Just $ Fixity NoSourceText 4 InfixL
   "<$>"       -> Just $ Fixity NoSourceText 4 InfixL
   "<&>"       -> Just $ Fixity NoSourceText 1 InfixL
   "&"         -> Just $ Fixity NoSourceText 1 InfixL
@@ -245,6 +247,7 @@ hardcodedFixity allowUnqualify = \case
   "`shiftR`"  -> Just $ Fixity NoSourceText 8 InfixL
   "`rotateL`" -> Just $ Fixity NoSourceText 8 InfixL
   "`rotateR`" -> Just $ Fixity NoSourceText 8 InfixL
+  "+#"        -> Just $ Fixity NoSourceText 6 InfixL
   ".^."       -> Just $ Fixity NoSourceText 6 InfixL
   ".>>."      -> Just $ Fixity NoSourceText 8 InfixL
   ".<<."      -> Just $ Fixity NoSourceText 8 InfixL
@@ -265,6 +268,8 @@ hardcodedFixity allowUnqualify = \case
   ".>"        -> Just $ Fixity NoSourceText 9 InfixL
   ":?"        -> Just $ Fixity NoSourceText 7 InfixN
   ":-"        -> Just $ Fixity NoSourceText 9 InfixR
+  ".:"        -> Just $ Fixity NoSourceText 9 InfixR
+  ".="        -> Just $ Fixity NoSourceText 8 InfixR
 
   str         -> case (Safe.headMay str, Safe.lastMay str) of
     (Just '\'', _) -> hardcodedFixity False (drop 1 str)

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

@@ -220,7 +220,7 @@ layoutExpr lexpr@(L _ expr) = do
           ]
         , docPar e (docSeq [docLit $ Text.pack "@", t])
         ]
-    OpApp _topEpAnn _expLeft@(L _ OpApp{}) _expOp _expRight -> do
+    OpApp _topEpAnn _expLeft _expOp _expRight -> do
       -- let
       --   allowPar = case (expOp, expRight) of
       --     (L _ (HsVar _ (L _ (Unqual occname))), _)
@@ -235,60 +235,6 @@ layoutExpr lexpr@(L _ expr) = do
       treeAndHasComms <-
         layout_gatherOpTreeE layouters False False id Nothing Nothing [] lexpr
       layout_opTree layouters treeAndHasComms
-    OpApp epAnn expLeft expOp expRight -> docHandleComms epAnn $ do
-      expDocLeft  <- shareDoc $ layoutExpr expLeft
-      expDocOp    <- shareDoc $ layoutExpr expOp
-      expDocRight <- shareDoc $ layoutExpr expRight
-      let
-        allowPar = case (expOp, expRight) of
-          (L _ (HsVar _ (L _ (Unqual occname))), _)
-            | occNameString occname == "$" -> True
-          (_, L _ (HsApp _ _ (L _ HsVar{}))) -> False
-          _ -> True
-      let leftIsDoBlock = case expLeft of
-            L _ HsDo{} -> True
-            _          -> False
-      runFilteredAlternative $ do
-        -- one-line
-        addAlternative $ docSeq
-          [ appSep $ docForceSingleline expDocLeft
-          , appSep $ docForceSingleline expDocOp
-          , docForceSingleline expDocRight
-          ]
-        -- -- line + freely indented block for right expression
-        -- addAlternative
-        --   $ docSeq
-        --   [ appSep $ docForceSingleline expDocLeft
-        --   , appSep $ docForceSingleline expDocOp
-        --   , docSetBaseY $ docAddBaseY BrIndentRegular expDocRight
-        --   ]
-        -- two-line
-        addAlternative $ do
-          let expDocOpAndRight = docForceSingleline $ docCols
-                ColOpPrefix
-                [appSep $ expDocOp, docSetBaseY expDocRight]
-          if leftIsDoBlock
-            then docLines [expDocLeft, expDocOpAndRight]
-            else docAddBaseY BrIndentRegular
-              $ docPar expDocLeft expDocOpAndRight
-              -- TODO: in both cases, we don't force expDocLeft to be
-              -- single-line, which has certain.. interesting consequences.
-              -- At least, the "two-line" label is not entirely
-              -- accurate.
-        -- one-line + par
-        addAlternativeCond allowPar $ docSeq
-          [ appSep $ docForceSingleline expDocLeft
-          , appSep $ docForceSingleline expDocOp
-          , docForceParSpacing expDocRight
-          ]
-        -- more lines
-        addAlternative $ do
-          let expDocOpAndRight =
-                docCols ColOpPrefix [appSep expDocOp, docSetBaseY expDocRight]
-          if leftIsDoBlock
-            then docLines [expDocLeft, expDocOpAndRight]
-            else docAddBaseY BrIndentRegular
-              $ docPar expDocLeft expDocOpAndRight
     NegApp _ op _ -> do
       opDoc <- shareDoc $ layoutExpr op
       docSeq [docLit $ Text.pack "-", opDoc]

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

@@ -258,7 +258,10 @@ layoutOpTree allowSinglelinePar = \case
         -- or
         -- > one + two + case x of
         -- >   _ -> three
-        addAlternativeCond allowSinglelinePar $ wrapParenIfSl hasParen $ docSeq
+        addAlternativeCond allowSinglelinePar
+          $ wrapParenIfSl hasParen
+          $ docSetParSpacing
+          $ docSeq
           ([docForceSingleline docL] ++ case splitFirstLast sharedOps of
             FirstLastEmpty -> []
             FirstLastSingleton (od, ed) ->