Fix top-level comment position+whitespace bug

ghc92
Lennart Spitzner 2023-05-12 20:43:05 +00:00
parent 860c8771ae
commit e38836fdab
3 changed files with 42 additions and 16 deletions

View File

@ -993,3 +993,8 @@ func = do
doeeRbaviceQzymin a b = olivhuwqbaq
iqnz biwomeJhhujy _ _ | biwomeJhhujy < volpoqAsizmHdwpl = pure 0
pure True
#test comment-inside-decl
func False = 0
-- comment
func True = 1

View File

@ -56,7 +56,9 @@ import GHC.Parser.Annotation ( DeltaPos
)
, EpaCommentTok(EpaEofComment)
)
import GHC.Types.SrcLoc ( realSrcSpanEnd )
import GHC.Types.SrcLoc ( realSrcSpanEnd
, realSrcSpanStart
)
import qualified Language.Haskell.GHC.ExactPrint.Types
as ExactPrint
import qualified Language.Haskell.GHC.ExactPrint.Utils
@ -161,12 +163,23 @@ enrichDecls
:: ExactPrint.Pos -> [LHsDecl GhcPs] -> FinalList ModuleElement ExactPrint.Pos
enrichDecls lastSpanEnd = \case
[] -> finalPure $ lastSpanEnd
(L (SrcSpanAnn dAnn rlspan@(GHC.RealSrcSpan span _)) decl : declRest) ->
L (SrcSpanAnn dAnn rlspan@(GHC.RealSrcSpan span _)) decl : declRest ->
case dAnn of
EpAnn dAnchor items (EpaComments dComments) -> do
let
withoutComments =
(L (SrcSpanAnn (EpAnn dAnchor items (EpaComments [])) rlspan) decl)
(innerComments, outerComments) =
partition
(\(L (Anchor anch _) _) ->
realSrcSpanStart anch < realSrcSpanEnd span
)
dComments
withoutOuterComments =
(L
(SrcSpanAnn (EpAnn dAnchor items (EpaComments innerComments))
rlspan
)
decl
)
commentExtract = \case
L (GHC.Anchor anch _) EpaComment{} -> ExactPrint.ss2posEnd anch
-- It would be really nice if `ExactPrint.ss2posEnd span` was
@ -180,20 +193,27 @@ enrichDecls lastSpanEnd = \case
-- throughout the code now. But optimizing it is not easy, and
-- at worst it is larger constant factor on the size of the
-- input, so it isn't _that_ bad.
fixedSpanEnd = SYB.everything
max
(SYB.mkQ (ExactPrint.ss2posEnd span) commentExtract)
decl
fixedSpanEnd =
SYB.everything
max
(SYB.mkQ (ExactPrint.ss2posEnd span) commentExtract)
decl
case ExactPrint.ss2delta lastSpanEnd span of
SameLine{} -> pure ()
DifferentLine n _ ->
finalYield $ MEWhitespace $ DifferentLine (n - 1) 1
let (afterComms, span2) = finalToList $ enrichComms fixedSpanEnd (reverse dComments)
let (immediate, later) = List.span (\case
MEComment{} -> True
_ -> False
) afterComms
finalYield $ MEDecl withoutComments [ comm | MEComment comm <- immediate ]
let (afterComms, span2) = finalToList
$ enrichComms fixedSpanEnd (reverse outerComments)
let (immediate, later) =
List.span
(\case
MEComment{} -> True
_ -> False
)
afterComms
finalYield
$ MEDecl withoutOuterComments [ comm | MEComment comm <- immediate ]
-- $ MEDecl ldecl []
later `forM_` finalYield
enrichDecls span2 declRest
EpAnn _anchor _items (EpaCommentsBalanced{}) ->

View File

@ -151,8 +151,9 @@ processModule traceFunc conf inlineConf parsedModule = do
-- MEExactModuleHead{} -> useTraceFunc traceFunc "MEExactModuleHead"
-- MEPrettyModuleHead{} -> useTraceFunc traceFunc "MEPrettyModuleHead"
-- MEImportDecl{} -> useTraceFunc traceFunc "MEImportDecl"
-- MEDecl{} -> useTraceFunc traceFunc "MEDecl"
-- MEComment{} -> useTraceFunc traceFunc "MEComment"
-- MEDecl decl _ -> useTraceFunc traceFunc ("MEDecl " ++ intercalate "," (getDeclBindingNames decl))
-- MEComment (y, EpaLineComment str) -> useTraceFunc traceFunc ("MEComment " ++ show y ++ " " ++ str)
-- MEComment (y, _) -> useTraceFunc traceFunc ("MEComment " ++ show y ++ " _")
-- MEWhitespace dp -> useTraceFunc traceFunc ("MEWhitespace " ++ show dp)
-- rest
-- )