From ab27825b7bfc9a8a4df430dd7e7fc326abae5af7 Mon Sep 17 00:00:00 2001
From: Lennart Spitzner <hexagoxel@hexagoxel.de>
Date: Fri, 6 Jul 2018 22:41:31 +0200
Subject: [PATCH] Core layouting algo improvement (non-bottom more effective)

During alt-transform, when gather spacings, previously
we tracked different non-bottom spacings separately even
though they would be treated in the same way during any
future transformations (apart from certain exceptions that
don't practically give better results). Instead we now
merge such spacings into one, giving more space for other
spacings when pruning to the spacings limit.
---
 src-literatetests/15-regressions.blt          | 14 ++++++++
 .../Brittany/Internal/Transformations/Alt.hs  | 35 ++++++++++++++++---
 2 files changed, 44 insertions(+), 5 deletions(-)

diff --git a/src-literatetests/15-regressions.blt b/src-literatetests/15-regressions.blt
index 7e303cc..6d0be5d 100644
--- a/src-literatetests/15-regressions.blt
+++ b/src-literatetests/15-regressions.blt
@@ -637,3 +637,17 @@ spec = do
     lift $ do
       studentDiagnosticReadingLevel updatedStudent `shouldBe` Just 10 -- x
       elaSnapshotReadingLevel snapshot `shouldBe` 12
+
+#test non-bottom-specialcase-altsearch
+jaicyhHumzo btrKpeyiFej mava = do
+  m :: VtohxeRgpmgsu <- qloxIfiq mava
+  case m of
+    ZumnaoFujayerIswadabo kkecm chlixxag -> do
+      imomue <- ozisduRaqiseSBAob btrKpeyiFej $ \s ->
+        case MizA.pigevo kkecm (_tc_gulawulu s) of
+          Ebocaba ->
+            ( s { _tc_gulawulu = MizA.jxariu kkecm rwuRqxzhjo (_tc_gulawulu s) }
+            , Gtzvonm
+            )
+          Xcde{} -> (s, Pioemav)
+      pure imomue
diff --git a/src/Language/Haskell/Brittany/Internal/Transformations/Alt.hs b/src/Language/Haskell/Brittany/Internal/Transformations/Alt.hs
index f247170..218f596 100644
--- a/src/Language/Haskell/Brittany/Internal/Transformations/Alt.hs
+++ b/src/Language/Haskell/Brittany/Internal/Transformations/Alt.hs
@@ -545,6 +545,8 @@ getSpacing !bridoc = rec bridoc
     VerticalSpacingParNone -> 0
     VerticalSpacingParAlways i -> i
 
+data SpecialCompare = Unequal | Smaller | Bigger
+
 getSpacings
   :: forall m
    . (MonadMultiReader Config m, MonadMultiWriter (Seq String) m)
@@ -571,6 +573,29 @@ getSpacings limit bridoc = preFilterLimit <$> rec bridoc
               VerticalSpacingParNone -> True
               VerticalSpacingParSome i -> i <= colMax
               VerticalSpacingParAlways{} -> True
+      let specialCompare vs1 vs2 =
+            if (  (_vs_sameLine vs1 == _vs_sameLine vs2)
+               && (_vs_parFlag vs1 == _vs_parFlag vs2)
+               )
+              then case (_vs_paragraph vs1, _vs_paragraph vs2) of
+                (VerticalSpacingParAlways i1, VerticalSpacingParAlways i2) ->
+                  if i1 < i2 then Smaller else Bigger
+                (p1, p2) -> if p1 == p2 then Smaller else Unequal
+              else Unequal
+      let -- this is like List.nub, with one difference: if two elements
+          -- are unequal only in _vs_paragraph, with both ParAlways, we
+          -- treat them like equals and replace the first occurence with the
+          -- smallest member of this "equal group".
+          specialNub :: [VerticalSpacing] -> [VerticalSpacing]
+          specialNub [] = []
+          specialNub (x1 : xr) = case go x1 xr of
+            (r, xs') -> r : specialNub xs'
+           where
+            go y1 []        = (y1, [])
+            go y1 (y2 : yr) = case specialCompare y1 y2 of
+              Unequal -> let (r, yr') = go y1 yr in (r, y2 : yr')
+              Smaller -> go y1 yr
+              Bigger  -> go y2 yr
       let -- the standard function used to enforce a constant upper bound
           -- on the number of elements returned for each node. Should be
           -- applied whenever in a parent the combination of spacings from
@@ -579,11 +604,7 @@ getSpacings limit bridoc = preFilterLimit <$> rec bridoc
           filterAndLimit = take limit
                            -- prune so we always consider a constant
                            -- amount of spacings per node of the BriDoc.
-                         . filter hasOkColCount
-                           -- throw out any spacings (i.e. children) that
-                           -- already use more columns than available in
-                           -- total.
-                         . List.nub
+                         . specialNub
                            -- In the end we want to know if there is at least
                            -- one valid spacing for any alternative.
                            -- If there are duplicates in the list, then these
@@ -605,6 +626,10 @@ getSpacings limit bridoc = preFilterLimit <$> rec bridoc
                            -- layouts when we can than take non-optimal layouts
                            -- just to be consistent with other cases where
                            -- we'd choose non-optimal layouts.
+                         . filter hasOkColCount
+                           -- throw out any spacings (i.e. children) that
+                           -- already use more columns than available in
+                           -- total.
                          . preFilterLimit
       result <- case brdc of
         -- BDWrapAnnKey _annKey bd -> rec bd