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.
Lennart Spitzner 2023-05-30 11:43:52 +02:00
parent 49a2529a5b
commit 12f36a2383
2 changed files with 30 additions and 8 deletions

View File

@ -33,8 +33,12 @@ import GHC ( Anchor(Anchor)
, DeltaPos(SameLine, DifferentLine) , DeltaPos(SameLine, DifferentLine)
, srcLocLine , srcLocLine
, srcLocCol , srcLocCol
, srcSpanStartCol
, srcSpanStartLine
)
import GHC.Types.SrcLoc ( realSrcSpanEnd
, realSrcSpanStart
) )
import GHC.Types.SrcLoc ( realSrcSpanEnd )
import qualified GHC.OldList as List import qualified GHC.OldList as List
import qualified Language.Haskell.GHC.ExactPrint.Utils as ExactPrint import qualified Language.Haskell.GHC.ExactPrint.Utils as ExactPrint
@ -286,9 +290,9 @@ layoutBriDocM = \case
Just m -> Just m ->
let p1 = (srcLocLine m, srcLocCol m) let p1 = (srcLocLine m, srcLocCol m)
p2 = (srcLocLine loc, srcLocCol loc) p2 = (srcLocLine loc, srcLocCol loc)
in -- trace ("_lstate_plannedSpace = " ++ show (_lstate_plannedSpace s) in -- trace ("plannedSpace = " ++ show (_lstate_plannedSpace s)
-- ++ ", _lstate_markerForDelta = " ++ show (_lstate_markerForDelta s) -- ++ ", markerForDelta = " ++ show (_lstate_markerForDelta s)
-- ++ ", _lstate_curY = " ++ show (_lstate_curY s) -- ++ ", curY = " ++ show (_lstate_curY s)
-- ++ ", p1 = " ++ show p1 -- ++ ", p1 = " ++ show p1
-- ++ ", p2 = " ++ show p2 -- ++ ", p2 = " ++ show p2
-- ++ ", startCurY = " ++ show startCurY -- ++ ", startCurY = " ++ show startCurY
@ -352,10 +356,28 @@ takeBefore loc = do
printComments :: LayoutConstraints m => [GHC.LEpaComment] -> m () printComments :: LayoutConstraints m => [GHC.LEpaComment] -> m ()
printComments comms = do printComments comms = do
let addComment isBlock s anchor prior = do let addComment isBlock s anchor prior = do
curY <- _lstate_curY <$> mGet
case anchor of case anchor of
Anchor span UnchangedAnchor -> do Anchor span UnchangedAnchor -> do
let dp = ExactPrint.ss2deltaEnd prior span case ExactPrint.ss2deltaEnd prior span of
layoutWriteComment True isBlock dp 1 (Text.pack s) -- 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 if isBlock
then layoutSetMarker $ Just $ realSrcSpanEnd span then layoutSetMarker $ Just $ realSrcSpanEnd span
else layoutUpdateMarker $ realSrcSpanEnd span else layoutUpdateMarker $ realSrcSpanEnd span

View File

@ -133,7 +133,7 @@ layoutWriteComment
-> Int -> Int
-> Text -> Text
-> m () -> 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 let (y, x) = case dp of
GHC.SameLine c -> (0, c) GHC.SameLine c -> (0, c)
GHC.DifferentLine l c -> (l, 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) PlannedNone -> PlannedDelta 1 (_lstate_curY state)
PlannedSameline i -> PlannedDelta 1 (_lstate_curY state + i) PlannedSameline i -> PlannedDelta 1 (_lstate_curY state + i)
p@PlannedNewline{} -> p p@PlannedNewline{} -> p
p@PlannedDelta{} -> p PlannedDelta n _ -> PlannedNewline n
, _lstate_commentNewlines = _lstate_commentNewlines state , _lstate_commentNewlines = _lstate_commentNewlines state
+ y + y
+ commentLines + commentLines