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

View File

@ -1074,3 +1074,19 @@ func = process $ do
+ cccccccccccccccccccccccccccccccccccccccccccccccccc + cccccccccccccccccccccccccccccccccccccccccccccccccc
) )
`shouldReturn` thing `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

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,9 +356,27 @@ 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
-- 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) layoutWriteComment True isBlock dp 1 (Text.pack s)
if isBlock if isBlock
then layoutSetMarker $ Just $ realSrcSpanEnd span then layoutSetMarker $ Just $ 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)
@ -156,7 +156,8 @@ layoutWriteComment absolute isBlock dp commentLines s = do -- TODO92 we don't mo
p@PlannedNone -> p p@PlannedNone -> p
p@PlannedSameline{} -> p p@PlannedSameline{} -> p
PlannedNewline l -> 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 -> PlannedDelta l i ->
if l <= y && Data.Maybe.isNothing (_lstate_markerForDelta state) if l <= y && Data.Maybe.isNothing (_lstate_markerForDelta state)
then PlannedSameline 1 then PlannedSameline 1