From 7ab6a207ae37bc7add862784905c3a03d74437ac Mon Sep 17 00:00:00 2001
From: Lennart Spitzner <hexagoxel@hexagoxel.de>
Date: Fri, 21 Apr 2023 12:22:30 +0000
Subject: [PATCH] Update OpApp layouting options

- Allow par-spacing for single-operator 1+n-line layout
- Tweak when to flatten operators, i.e. when to allow a flat one-line-each
  layout for the operator sequence "$ $ $ + +".
---
 data/10-structured/expression-special.blt     | 11 +++-----
 data/10-structured/op-precedence.blt          |  6 +++--
 data/15-regressions.blt                       |  7 +++---
 .../Brittany/Internal/ToBriDoc/OpTree.hs      | 25 +++++++++++++++++--
 4 files changed, 34 insertions(+), 15 deletions(-)

diff --git a/data/10-structured/expression-special.blt b/data/10-structured/expression-special.blt
index dc4b7fe..75f4d4b 100644
--- a/data/10-structured/expression-special.blt
+++ b/data/10-structured/expression-special.blt
@@ -2,13 +2,10 @@
 
 
 #test monad-comprehension-case-of
-func =
-  foooooo
-    $ [ case
-          foooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooo
-        of
-          _ -> True
-      ]
+func = foooooo
+  $ [ case foooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooo of
+        _ -> True
+    ]
 
 #test operatorprefixalignment-even-with-multiline-alignbreak
 func =
diff --git a/data/10-structured/op-precedence.blt b/data/10-structured/op-precedence.blt
index 3b3ec38..ef32d59 100644
--- a/data/10-structured/op-precedence.blt
+++ b/data/10-structured/op-precedence.blt
@@ -164,12 +164,14 @@ doop =
 #expected
 -- brittany { lconfig_fixityBasedAddAlignParens: True }
 doop =
-  (  some long invocation == loooooooooongman + (third nested expression) - 4
+  (  (  some long invocation == loooooooooongman + (third nested expression) - 4
      && {- meow -} 5 - 6 > 7 `mod` loooooooooongwoman
+     )
   || ill just invoke a function with these args
   || (  foo
-     && dooasdoiaosdoi ** oaisdoioasido
+     && (  dooasdoiaosdoi ** oaisdoioasido
         <= asduiuaisduiasdu + asdahjsd + ahsjdhjhasd
+        )
      )
   )
 
diff --git a/data/15-regressions.blt b/data/15-regressions.blt
index eee9c08..51ec51f 100644
--- a/data/15-regressions.blt
+++ b/data/15-regressions.blt
@@ -319,10 +319,9 @@ parserCompactLocation =
   ]
 
 #test opapp-specialcasing-1
-func =
-  fooooooooooooooooooooooooooooooooo
-    $ foooooooooooooooooooooooooooooooo foooooooooooooooooooooooooooooooo
-                                        foooooooooooooooooooooooooooooooo
+func = fooooooooooooooooooooooooooooooooo
+  $ foooooooooooooooooooooooooooooooo foooooooooooooooooooooooooooooooo
+                                      foooooooooooooooooooooooooooooooo
 
 #test opapp-specialcasing-2
 func =
diff --git a/source/library/Language/Haskell/Brittany/Internal/ToBriDoc/OpTree.hs b/source/library/Language/Haskell/Brittany/Internal/ToBriDoc/OpTree.hs
index d43a82f..5d2db18 100644
--- a/source/library/Language/Haskell/Brittany/Internal/ToBriDoc/OpTree.hs
+++ b/source/library/Language/Haskell/Brittany/Internal/ToBriDoc/OpTree.hs
@@ -222,6 +222,7 @@ layoutOpTree allowSinglelinePar = \case
     -> ToBriDocM BriDocNumbered
   coreAlternative hasParen locO locC fixity docL sharedOps sharedOpsFlat lastWrap
     = do
+      indentPolicy <- askLayoutConf _lconfig_indentPolicy
       let wrapParenIfSl x inner = if x then wrapParenSl inner else docSetParSpacing inner
           wrapParenSl inner = docAlt
             [ docSeq
@@ -253,6 +254,8 @@ layoutOpTree allowSinglelinePar = \case
             Nothing                -> False
             Just (Fixity _ prec _) -> prec > 0
 
+      let isSingleOp = length sharedOps == 1 && length sharedOpsFlat == 1
+
       runFilteredAlternative $ do
         -- > one + two + three
         -- or
@@ -262,7 +265,7 @@ layoutOpTree allowSinglelinePar = \case
           $ wrapParenIfSl hasParen
           $ docSetParSpacing
           $ docSeq
-          ([docForceSingleline docL] ++ case splitFirstLast sharedOps of
+          ([docForceSingleline docL] ++ case splitFirstLast sharedOpsFlat of
             FirstLastEmpty -> []
             FirstLastSingleton (od, ed) ->
               [docSeparator, docForceSingleline od, docSeparator, lastWrap ed]
@@ -289,11 +292,29 @@ layoutOpTree allowSinglelinePar = \case
           )
         -- this case rather leads to some unfortunate layouting than to anything
         -- useful; disabling for now. (it interfers with cols stuff.)
-        addAlternativeCond (not hasParen) $ docPar
+        -- one
+        -- + two
+        -- + three
+        addAlternativeCond (not hasParen && not isSingleOp) $ docPar
           (docHandleComms locO $ docForceSingleline $ docL)
           (docFlushCommsPost False locC $ docLines $ sharedOps <&> \(od, ed) ->
             docCols ColOpPrefix [appSep od, docForceSingleline ed]
           )
+        let singlelineUnlessFree = case indentPolicy of
+              IndentPolicyLeft     -> docForceSingleline
+              IndentPolicyMultiple -> docForceSingleline
+              IndentPolicyFree     -> id
+        let curIsPrec0 = case fixity of
+              Nothing -> False
+              Just (Fixity _ prec _) -> prec == 0
+        case sharedOps of
+          [(od, ed)] | curIsPrec0 ->
+            addAlternativeCond (not hasParen && isSingleOp)
+              $ docSetParSpacing
+              $ docPar
+                (docHandleComms locO $ docForceSingleline $ docL)
+                (docSeq [od, docSeparator, singlelineUnlessFree ed])
+          _ -> pure ()
         -- > ( one
         -- > + two
         -- > + three