From 7bbbea728d5744b9a5341f235ac1925fc3c4bcce Mon Sep 17 00:00:00 2001
From: Lennart Spitzner <hexagoxel@hexagoxel.de>
Date: Tue, 30 May 2023 11:43:52 +0200
Subject: [PATCH] Fix another two comment spacing special-cases using hacks

Whole thing is ugly. Exactprint decided to not include a proper
delta for that one comment, so needed a special workaround that
then needs special exceptions too.

The whole thing is a mess at this point and needs a re-think.
At least we now have a proper test-suite for these kinds of
problems.
---
 data/15-regressions.blt                       | 16 +++++++++
 .../Haskell/Brittany/Internal/WriteBriDoc.hs  | 34 +++++++++++++++----
 .../Internal/WriteBriDoc/Operators.hs         |  5 +--
 3 files changed, 47 insertions(+), 8 deletions(-)

diff --git a/data/15-regressions.blt b/data/15-regressions.blt
index 1e5d039..5f1cbd3 100644
--- a/data/15-regressions.blt
+++ b/data/15-regressions.blt
@@ -1074,3 +1074,19 @@ func = process $ do
     + cccccccccccccccccccccccccccccccccccccccccccccccccc
     )
     `shouldReturn` thing
+
+#test do-block block-comment comment statement sequence
+func = do
+  lec <- hrmexs
+
+  {- HLINT ignore "blub" -}
+  -- hlint thinks we can bring `qweqwe` outside of the `maybe`,
+  -- but that's a type error.
+  let jebnaZiegui = UtatUcaOrgmqf
+        $ eqazak
+          (NO.kaeyuo . NO.FUGOKovsxq)
+          (maybe (NO.kaeyuo NO.UvmsoItqOguTOLqtuld)
+                 (NO.kaeyuo . NO.XvswJUBeroci)
+          )
+          nogcVassuVvbFiew
+      kyxson = vzahxEooRecOriqdp apneZejuzTfuQkuJosqoa
diff --git a/source/library/Language/Haskell/Brittany/Internal/WriteBriDoc.hs b/source/library/Language/Haskell/Brittany/Internal/WriteBriDoc.hs
index 035b697..03710de 100644
--- a/source/library/Language/Haskell/Brittany/Internal/WriteBriDoc.hs
+++ b/source/library/Language/Haskell/Brittany/Internal/WriteBriDoc.hs
@@ -33,8 +33,12 @@ import           GHC                            ( Anchor(Anchor)
                                                 , DeltaPos(SameLine, DifferentLine)
                                                 , srcLocLine
                                                 , srcLocCol
+                                                , srcSpanStartCol
+                                                , srcSpanStartLine
+                                                )
+import           GHC.Types.SrcLoc               ( realSrcSpanEnd
+                                                , realSrcSpanStart
                                                 )
-import           GHC.Types.SrcLoc               ( realSrcSpanEnd )
 import qualified GHC.OldList                   as List
 
 import qualified Language.Haskell.GHC.ExactPrint.Utils as ExactPrint
@@ -286,9 +290,9 @@ layoutBriDocM = \case
           Just m ->
             let p1 = (srcLocLine m, srcLocCol m)
                 p2 = (srcLocLine loc, srcLocCol loc)
-            in -- trace ("_lstate_plannedSpace = " ++ show (_lstate_plannedSpace s)
-               --   ++ ", _lstate_markerForDelta = " ++ show (_lstate_markerForDelta s)
-               --   ++ ", _lstate_curY = " ++ show (_lstate_curY s)
+            in -- trace ("plannedSpace = " ++ show (_lstate_plannedSpace s)
+               --   ++ ", markerForDelta = " ++ show (_lstate_markerForDelta s)
+               --   ++ ", curY = " ++ show (_lstate_curY s)
                --   ++ ", p1 = " ++ show p1
                --   ++ ", p2 = " ++ show p2
                --   ++ ", startCurY = " ++ show startCurY
@@ -352,10 +356,28 @@ takeBefore loc = do
 printComments :: LayoutConstraints m => [GHC.LEpaComment] -> m ()
 printComments comms = do
   let addComment isBlock s anchor prior = do
+        curY <- _lstate_curY <$> mGet
         case anchor of
           Anchor span UnchangedAnchor -> do
-            let dp = ExactPrint.ss2deltaEnd prior span
-            layoutWriteComment True isBlock dp 1 (Text.pack s)
+            case ExactPrint.ss2deltaEnd prior span of
+                  -- this is a stupid shitty hacky workaround
+                  -- because exactprint _sometimes_ decides that
+                  -- block comments don't get a proper prior span
+                  -- assigned and it breaks everything.
+                  SameLine 0
+                    | isBlock
+                    , srcSpanStartLine span > 1
+                    , srcSpanStartCol span /= curY + 1
+                    -> do
+                    layoutSetMarker $ Just $ realSrcSpanStart span
+                    layoutWriteComment
+                      True
+                      isBlock
+                      (DifferentLine 1 (srcSpanStartCol span))
+                      1
+                      (Text.pack s)
+                  dp -> do
+                    layoutWriteComment True isBlock dp 1 (Text.pack s)
             if isBlock
               then layoutSetMarker $ Just $ realSrcSpanEnd span
               else layoutUpdateMarker $ realSrcSpanEnd span
diff --git a/source/library/Language/Haskell/Brittany/Internal/WriteBriDoc/Operators.hs b/source/library/Language/Haskell/Brittany/Internal/WriteBriDoc/Operators.hs
index 354d4d6..f039e18 100644
--- a/source/library/Language/Haskell/Brittany/Internal/WriteBriDoc/Operators.hs
+++ b/source/library/Language/Haskell/Brittany/Internal/WriteBriDoc/Operators.hs
@@ -133,7 +133,7 @@ layoutWriteComment
   -> Int
   -> Text
   -> m ()
-layoutWriteComment absolute isBlock dp commentLines s = do -- TODO92 we don't move to comment pos at all!
+layoutWriteComment absolute isBlock dp commentLines s = do
   let (y, x) = case dp of
         GHC.SameLine c        -> (0, c)
         GHC.DifferentLine l c -> (l, c)
@@ -156,7 +156,8 @@ layoutWriteComment absolute isBlock dp commentLines s = do -- TODO92 we don't mo
         p@PlannedNone       -> p
         p@PlannedSameline{} -> p
         PlannedNewline l ->
-          if l <= y then PlannedSameline 1 else PlannedNewline (l - y)
+          -- trace ("setting to sameline " ++ show (l, y)) $ if l <= y then PlannedSameline 1 else PlannedNewline (l - y)
+          PlannedNewline (l - y)
         PlannedDelta l i ->
           if l <= y && Data.Maybe.isNothing (_lstate_markerForDelta state)
             then PlannedSameline 1