diff --git a/data/15-regressions.blt b/data/15-regressions.blt index caabd04..84a56de 100644 --- a/data/15-regressions.blt +++ b/data/15-regressions.blt @@ -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 diff --git a/source/library/Language/Haskell/Brittany/Internal/S2_SplitModule.hs b/source/library/Language/Haskell/Brittany/Internal/S2_SplitModule.hs index a106526..7dc1deb 100644 --- a/source/library/Language/Haskell/Brittany/Internal/S2_SplitModule.hs +++ b/source/library/Language/Haskell/Brittany/Internal/S2_SplitModule.hs @@ -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{}) -> diff --git a/source/library/Language/Haskell/Brittany/Internal/StepOrchestrate.hs b/source/library/Language/Haskell/Brittany/Internal/StepOrchestrate.hs index b1b2f1d..8ce57a3 100644 --- a/source/library/Language/Haskell/Brittany/Internal/StepOrchestrate.hs +++ b/source/library/Language/Haskell/Brittany/Internal/StepOrchestrate.hs @@ -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 -- )