Fix top-level comment position+whitespace bug
parent
860c8771ae
commit
e38836fdab
|
@ -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
|
||||
|
|
|
@ -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{}) ->
|
||||
|
|
|
@ -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
|
||||
-- )
|
||||
|
|
Loading…
Reference in New Issue