From 12f36a2383fd9ca10fb7065fc4bec93f11614f76 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.
---
 .../Haskell/Brittany/Internal/WriteBriDoc.hs  | 34 +++++++++++++++----
 .../Internal/WriteBriDoc/Operators.hs         |  4 +--
 2 files changed, 30 insertions(+), 8 deletions(-)

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..d592adb 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)
@@ -165,7 +165,7 @@ layoutWriteComment absolute isBlock dp commentLines s = do -- TODO92 we don't mo
         PlannedNone        -> PlannedDelta 1 (_lstate_curY state)
         PlannedSameline i  -> PlannedDelta 1 (_lstate_curY state + i)
         p@PlannedNewline{} -> p
-        p@PlannedDelta{}   -> p
+        PlannedDelta n _   -> PlannedNewline n
     , _lstate_commentNewlines = _lstate_commentNewlines state
                                 + y
                                 + commentLines