diff --git a/hls-test-utils/src/Test/Hls.hs b/hls-test-utils/src/Test/Hls.hs index cb566078b5..9c9ae177dc 100644 --- a/hls-test-utils/src/Test/Hls.hs +++ b/hls-test-utils/src/Test/Hls.hs @@ -87,7 +87,6 @@ import Development.IDE (IdeState, LoggingColumn (ThreadIdColumn), defaultLayoutOptions, layoutPretty, renderStrict) -import qualified Development.IDE.LSP.Notifications as Notifications import Development.IDE.Main hiding (Log) import qualified Development.IDE.Main as IDEMain import Development.IDE.Plugin.Test (TestRequest (GetBuildKeysBuilt, WaitForIdeRule, WaitForShakeQueue), @@ -105,7 +104,6 @@ import Ide.Logger (Pretty (pretty), makeDefaultStderrRecorder, (<+>)) import qualified Ide.Logger as Logger -import Ide.Plugin.Properties ((&)) import Ide.PluginUtils (idePluginsToPluginDesc, pluginDescToIdePlugins) import Ide.Types diff --git a/plugins/hls-class-plugin/src/Ide/Plugin/Class/ExactPrint.hs b/plugins/hls-class-plugin/src/Ide/Plugin/Class/ExactPrint.hs index c08e4344a6..2a44f68091 100644 --- a/plugins/hls-class-plugin/src/Ide/Plugin/Class/ExactPrint.hs +++ b/plugins/hls-class-plugin/src/Ide/Plugin/Class/ExactPrint.hs @@ -20,7 +20,12 @@ import Language.LSP.Protocol.Types (Range) makeEditText :: Monad m => ParsedModule -> DynFlags -> AddMinimalMethodsParams -> MaybeT m (T.Text, T.Text) makeEditText pm df AddMinimalMethodsParams{..} = do mDecls <- MaybeT . pure $ traverse (makeMethodDecl df) methodGroup - let ps = makeDeltaAst $ pm_parsed_source pm + let ps = +#if !MIN_VERSION_ghc(9,9,0) + makeDeltaAst $ +#endif + pm_parsed_source pm + old = T.pack $ exactPrint ps (ps', _, _) = runTransform (addMethodDecls ps mDecls range withSig) new = T.pack $ exactPrint ps' @@ -44,8 +49,10 @@ addMethodDecls ps mDecls range withSig go inserting = do allDecls <- hsDecls ps case break (inRange range . getLoc) allDecls of - (before, L l inst : after) -> replaceDecls ps (before ++ L l (addWhere inst):(map newLine inserting ++ after)) - (before, []) -> replaceDecls ps before + (before, L l inst : after) -> + replaceDecls ps (before ++ L l (addWhere inst):(map newLine inserting ++ after)) + (before, []) -> + replaceDecls ps before -- Add `where` keyword for `instance X where` if `where` is missing. -- @@ -57,33 +64,39 @@ addMethodDecls ps mDecls range withSig -- See the link for the original definition: -- https://hackage.haskell.org/package/ghc-9.2.1/docs/Language-Haskell-Syntax-Extension.html#t:XCClsInstDecl addWhere :: HsDecl GhcPs -> HsDecl GhcPs - addWhere _instd@(InstD xInstD (ClsInstD ext decl@ClsInstDecl{..})) = + addWhere instd@(InstD xInstD (ClsInstD ext decl@ClsInstDecl{..})) = case cid_ext of #if MIN_VERSION_ghc(9,9,0) - (warnings, anns, key) -> + (warnings, anns, key) + | any (\(AddEpAnn kw _ )-> kw == AnnWhere) anns -> instd + | otherwise -> InstD xInstD (ClsInstD ext decl { cid_ext = ( warnings - , AddEpAnn AnnWhere (EpaDelta (SameLine 1) []) : anns - , key) + , AddEpAnn AnnWhere d1 : anns + , key + ) }) #else (EpAnn entry anns comments, key) -> - InstD xInstD (ClsInstD ext decl { - cid_ext = (EpAnn - entry - (AddEpAnn AnnWhere (EpaDelta (SameLine 1) []) : anns) - comments - , key) - }) - _ -> _instd + InstD xInstD (ClsInstD ext decl { + cid_ext = (EpAnn + entry + (AddEpAnn AnnWhere d1 : anns) + comments + , key + ) + }) + _ -> instd #endif addWhere decl = decl - newLine (L l e) = - let dp = deltaPos 1 defaultIndent + #if MIN_VERSION_ghc(9,9,0) - in L (noAnnSrcSpanDP dp <> l) e + newLine (L _ e) = + let dp = deltaPos 1 (defaultIndent + 1) {- TODO why is this +1 needed? -} + in L (noAnnSrcSpanDP dp) e #else + newLine (L l e) = + let dp = deltaPos 1 defaultIndent in L (noAnnSrcSpanDP (getLoc l) dp <> l) e #endif - diff --git a/plugins/hls-class-plugin/test/Main.hs b/plugins/hls-class-plugin/test/Main.hs index ea4da718ff..1f9b70f2ca 100644 --- a/plugins/hls-class-plugin/test/Main.hs +++ b/plugins/hls-class-plugin/test/Main.hs @@ -63,9 +63,8 @@ codeActionTests = testGroup getActionByTitle "Add placeholders for 'g'" , goldenWithClass "Creates a placeholder for other two methods" "T6" "2" $ getActionByTitle "Add placeholders for 'g','h'" - , onlyRunForGhcVersions [GHC92, GHC94] "Only ghc-9.2+ enabled GHC2021 implicitly" $ - goldenWithClass "Don't insert pragma with GHC2021" "InsertWithGHC2021Enabled" "" $ - getActionByTitle "Add placeholders for '==' with signature(s)" + ,goldenWithClass "Don't insert pragma with GHC2021" "InsertWithGHC2021Enabled" "" $ + getActionByTitle "Add placeholders for '==' with signature(s)" , goldenWithClass "Insert pragma if not exist" "InsertWithoutPragma" "" $ getActionByTitle "Add placeholders for '==' with signature(s)" , goldenWithClass "Don't insert pragma if exist" "InsertWithPragma" "" $ @@ -132,8 +131,7 @@ codeLensTests = testGroup , goldenCodeLens "Apply code lens for local class" "LocalClassDefine" 0 , goldenCodeLens "Apply code lens on the same line" "Inline" 0 , goldenCodeLens "Don't insert pragma while existing" "CodeLensWithPragma" 0 - , onlyRunForGhcVersions [GHC92, GHC94] "Only ghc-9.2+ enabled GHC2021 implicitly" $ - goldenCodeLens "Don't insert pragma while GHC2021 enabled" "CodeLensWithGHC2021" 0 + , goldenCodeLens "Don't insert pragma while GHC2021 enabled" "CodeLensWithGHC2021" 0 , goldenCodeLens "Qualified name" "Qualified" 0 , goldenCodeLens "Type family" "TypeFamily" 0 , testCase "keep stale lens" $ do diff --git a/plugins/hls-class-plugin/test/testdata/T5.expected.hs b/plugins/hls-class-plugin/test/testdata/T5.expected.hs index 6c26425f34..fcc51c0787 100644 --- a/plugins/hls-class-plugin/test/testdata/T5.expected.hs +++ b/plugins/hls-class-plugin/test/testdata/T5.expected.hs @@ -1,4 +1,4 @@ -module T1 where +module T5 where data X = X diff --git a/plugins/hls-class-plugin/test/testdata/T5.hs b/plugins/hls-class-plugin/test/testdata/T5.hs index e7dc1d4da3..d33dd8b17c 100644 --- a/plugins/hls-class-plugin/test/testdata/T5.hs +++ b/plugins/hls-class-plugin/test/testdata/T5.hs @@ -1,4 +1,4 @@ -module T1 where +module T5 where data X = X diff --git a/plugins/hls-gadt-plugin/src/Ide/Plugin/GHC.hs b/plugins/hls-gadt-plugin/src/Ide/Plugin/GHC.hs index fff2096d44..e910f7606d 100644 --- a/plugins/hls-gadt-plugin/src/Ide/Plugin/GHC.hs +++ b/plugins/hls-gadt-plugin/src/Ide/Plugin/GHC.hs @@ -16,9 +16,9 @@ import Development.IDE.GHC.Compat.ExactPrint import GHC.Parser.Annotation (AddEpAnn (..), DeltaPos (..), EpAnn (..), - EpAnnComments (EpaComments), - spanAsAnchor) + EpAnnComments (EpaComments)) import Ide.PluginUtils (subRange) +import Language.Haskell.GHC.ExactPrint (d1) import Language.Haskell.GHC.ExactPrint.Parsers (parseDecl) -- See Note [Guidelines For Using CPP In GHCIDE Import Statements] @@ -34,8 +34,8 @@ import GHC.Parser.Annotation (TokenLocation (..)) #if !MIN_VERSION_ghc(9,9,0) import GHC.Parser.Annotation (Anchor (Anchor), AnchorOperation (MovedAnchor), - EpaLocation (EpaDelta), - SrcSpanAnn' (SrcSpanAnn)) + SrcSpanAnn' (SrcSpanAnn), + spanAsAnchor) import Language.Haskell.GHC.ExactPrint (showAst) #endif @@ -227,17 +227,13 @@ prettyGADTDecl df decl = -- Make every data constructor start with a new line and 2 spaces adjustCon :: LConDecl GP -> LConDecl GP #if MIN_VERSION_ghc(9,9,0) - adjustCon (L ann r) = - L (EpAnn (go (spanAsAnchor (getLoc ann))) (AnnListItem []) (EpaComments [])) r + adjustCon (L _ r) = + let delta = EpaDelta (DifferentLine 1 3) [] + in L (EpAnn delta (AnnListItem []) (EpaComments [])) r #else adjustCon (L (SrcSpanAnn _ loc) r) = - L (SrcSpanAnn (EpAnn (go (spanAsAnchor loc)) (AnnListItem []) (EpaComments [])) loc) r -#endif - where -#if MIN_VERSION_ghc(9,9,0) - go _ = EpaDelta (DifferentLine 1 2) [] -#else - go (Anchor a _) = Anchor a (MovedAnchor (DifferentLine 1 2)) + let go (Anchor a _) = Anchor a (MovedAnchor (DifferentLine 1 2)) + in L (SrcSpanAnn (EpAnn (go (spanAsAnchor loc)) (AnnListItem []) (EpaComments [])) loc) r #endif -- Adjust where annotation to the same line of the type constructor @@ -247,7 +243,7 @@ prettyGADTDecl df decl = #endif (\(AddEpAnn ann l) -> if ann == AnnWhere - then AddEpAnn AnnWhere (EpaDelta (SameLine 1) []) + then AddEpAnn AnnWhere d1 else AddEpAnn ann l )