diff --git a/.github/workflows/test.yml b/.github/workflows/test.yml index 44d46d00d9..69b6856068 100644 --- a/.github/workflows/test.yml +++ b/.github/workflows/test.yml @@ -135,7 +135,7 @@ jobs: HLS_WRAPPER_TEST_EXE: hls-wrapper run: cabal test wrapper-test --test-options="$TEST_OPTS --rerun-log-file .tasty-rerun-log-wrapper" - - if: matrix.test && !startsWith(matrix.ghc,'9.8') + - if: matrix.test name: Test hls-refactor-plugin run: cabal test hls-refactor-plugin --test-options="$TEST_OPTS" || cabal test hls-refactor-plugin --test-options="$TEST_OPTS" @@ -143,7 +143,7 @@ jobs: name: Test hls-floskell-plugin run: cabal test hls-floskell-plugin --test-options="$TEST_OPTS" || cabal test hls-floskell-plugin --test-options="$TEST_OPTS" - - if: matrix.test && !startsWith(matrix.ghc,'9.8') + - if: matrix.test name: Test hls-class-plugin run: cabal test hls-class-plugin --test-options="$TEST_OPTS" || cabal test hls-class-plugin --test-options="$TEST_OPTS" @@ -155,7 +155,7 @@ jobs: name: Test hls-eval-plugin run: cabal test hls-eval-plugin --test-options="$TEST_OPTS" || cabal test hls-eval-plugin --test-options="$TEST_OPTS" - - if: matrix.test && !startsWith(matrix.ghc,'9.8') + - if: matrix.test name: Test hls-splice-plugin run: cabal test hls-splice-plugin --test-options="$TEST_OPTS" || cabal test hls-splice-plugin --test-options="$TEST_OPTS" @@ -183,7 +183,7 @@ jobs: name: Test hls-call-hierarchy-plugin test suite run: cabal test hls-call-hierarchy-plugin --test-options="$TEST_OPTS" || cabal test hls-call-hierarchy-plugin --test-options="$TEST_OPTS" - - if: matrix.test && matrix.os != 'windows-latest' && !startsWith(matrix.ghc,'9.8') + - if: matrix.test && matrix.os != 'windows-latest' name: Test hls-rename-plugin test suite run: cabal test hls-rename-plugin --test-options="$TEST_OPTS" || cabal test hls-rename-plugin --test-options="$TEST_OPTS" @@ -211,7 +211,7 @@ jobs: name: Test hls-change-type-signature test suite run: cabal test hls-change-type-signature-plugin --test-options="$TEST_OPTS" || cabal test hls-change-type-signature-plugin --test-options="$TEST_OPTS" - - if: matrix.test && !startsWith(matrix.ghc,'9.8') + - if: matrix.test name: Test hls-gadt-plugin test suit run: cabal test hls-gadt-plugin --test-options="$TEST_OPTS" || cabal test hls-gadt-plugin --test-options="$TEST_OPTS" @@ -232,7 +232,7 @@ jobs: name: Test hls-cabal-plugin test suite run: cabal test hls-cabal-plugin --test-options="$TEST_OPTS" || cabal test hls-cabal-plugin --test-options="$TEST_OPTS" - - if: matrix.test && !startsWith(matrix.ghc,'9.8') + - if: matrix.test name: Test hls-retrie-plugin test suite run: cabal test hls-retrie-plugin --test-options="$TEST_OPTS" || cabal test hls-retrie-plugin --test-options="$TEST_OPTS" diff --git a/ghcide/src/Development/IDE/GHC/Compat/Core.hs b/ghcide/src/Development/IDE/GHC/Compat/Core.hs index caee9d5685..9f35fb6bf6 100644 --- a/ghcide/src/Development/IDE/GHC/Compat/Core.hs +++ b/ghcide/src/Development/IDE/GHC/Compat/Core.hs @@ -408,6 +408,7 @@ module Development.IDE.GHC.Compat.Core ( #endif groupOrigin, isVisibleFunArg, + lookupGlobalRdrEnv, ) where import qualified GHC @@ -825,3 +826,7 @@ mkSimpleTarget df fp = Target (TargetFile fp Nothing) True (homeUnitId_ df) Noth #else mkSimpleTarget _ fp = Target (TargetFile fp Nothing) True Nothing #endif + +#if MIN_VERSION_ghc(9,7,0) +lookupGlobalRdrEnv gre_env occ = lookupGRE gre_env (LookupOccName occ AllRelevantGREs) +#endif diff --git a/haskell-language-server.cabal b/haskell-language-server.cabal index 43ee12e74b..cd347c5dd1 100644 --- a/haskell-language-server.cabal +++ b/haskell-language-server.cabal @@ -217,7 +217,7 @@ common cabal cpp-options: -Dhls_cabal common class - if flag(class) && (impl(ghc < 9.8.0) || flag(ignore-plugins-ghc-bounds)) + if flag(class) build-depends: hls-class-plugin == 2.6.0.0 cpp-options: -Dhls_class @@ -237,12 +237,12 @@ common importLens cpp-options: -Dhls_importLens common rename - if flag(rename) && (impl(ghc < 9.8.0) || flag(ignore-plugins-ghc-bounds)) + if flag(rename) build-depends: hls-rename-plugin == 2.6.0.0 cpp-options: -Dhls_rename common retrie - if flag(retrie) && (impl(ghc < 9.8.0) || flag(ignore-plugins-ghc-bounds)) + if flag(retrie) build-depends: hls-retrie-plugin == 2.6.0.0 cpp-options: -Dhls_retrie @@ -267,7 +267,7 @@ common pragmas cpp-options: -Dhls_pragmas common splice - if flag(splice) && (impl(ghc < 9.8.0) || flag(ignore-plugins-ghc-bounds)) + if flag(splice) build-depends: hls-splice-plugin == 2.6.0.0 cpp-options: -Dhls_splice @@ -292,7 +292,7 @@ common changeTypeSignature cpp-options: -Dhls_changeTypeSignature common gadt - if flag(gadt) && (impl(ghc < 9.8.0) || flag(ignore-plugins-ghc-bounds)) + if flag(gadt) build-depends: hls-gadt-plugin == 2.6.0.0 cpp-options: -Dhls_gadt @@ -334,7 +334,7 @@ common stylishHaskell cpp-options: -Dhls_stylishHaskell common refactor - if flag(refactor) && (impl(ghc < 9.8.0) || flag(ignore-plugins-ghc-bounds)) + if flag(refactor) build-depends: hls-refactor-plugin == 2.6.0.0 cpp-options: -Dhls_refactor diff --git a/plugins/hls-class-plugin/hls-class-plugin.cabal b/plugins/hls-class-plugin/hls-class-plugin.cabal index 3ff633fd47..096d63cae5 100644 --- a/plugins/hls-class-plugin/hls-class-plugin.cabal +++ b/plugins/hls-class-plugin/hls-class-plugin.cabal @@ -29,11 +29,6 @@ common warnings library import: warnings - -- Plugins that need exactprint have not been updated for 9.8 yet - if impl(ghc >= 9.8) - buildable: False - else - buildable: True exposed-modules: Ide.Plugin.Class other-modules: Ide.Plugin.Class.CodeAction , Ide.Plugin.Class.CodeLens @@ -66,10 +61,6 @@ library test-suite tests import: warnings - if impl(ghc >= 9.8) - buildable: False - else - buildable: True type: exitcode-stdio-1.0 default-language: Haskell2010 hs-source-dirs: test diff --git a/plugins/hls-class-plugin/src/Ide/Plugin/Class/Types.hs b/plugins/hls-class-plugin/src/Ide/Plugin/Class/Types.hs index 49d92b564b..a3f0110544 100644 --- a/plugins/hls-class-plugin/src/Ide/Plugin/Class/Types.hs +++ b/plugins/hls-class-plugin/src/Ide/Plugin/Class/Types.hs @@ -5,6 +5,7 @@ {-# LANGUAGE RecordWildCards #-} {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE ViewPatterns #-} +{-# LANGUAGE CPP #-} module Ide.Plugin.Class.Types where @@ -207,7 +208,11 @@ getInstanceBindTypeSigsRule recorder = do (hscEnv -> hsc) <- useMT GhcSession nfp let binds = collectHsBindsBinders $ tcg_binds gblEnv (_, maybe [] catMaybes -> instanceBinds) <- liftIO $ - initTcWithGbl hsc gblEnv ghostSpan $ traverse bindToSig binds + initTcWithGbl hsc gblEnv ghostSpan +#if MIN_VERSION_ghc(9,7,0) + $ liftZonkM +#endif + $ traverse bindToSig binds pure $ InstanceBindTypeSigsResult instanceBinds where bindToSig id = do diff --git a/plugins/hls-gadt-plugin/hls-gadt-plugin.cabal b/plugins/hls-gadt-plugin/hls-gadt-plugin.cabal index b92142cbd7..1c2c915c5d 100644 --- a/plugins/hls-gadt-plugin/hls-gadt-plugin.cabal +++ b/plugins/hls-gadt-plugin/hls-gadt-plugin.cabal @@ -20,11 +20,6 @@ source-repository head location: https://github.com/haskell/haskell-language-server.git library - -- Plugins that need exactprint have not been updated for 9.8 yet - if impl(ghc >= 9.8) - buildable: False - else - buildable: True exposed-modules: Ide.Plugin.GADT other-modules: Ide.Plugin.GHC @@ -55,10 +50,6 @@ library default-extensions: DataKinds test-suite tests - if impl(ghc >= 9.8) - buildable: False - else - buildable: True type: exitcode-stdio-1.0 default-language: Haskell2010 hs-source-dirs: test diff --git a/plugins/hls-gadt-plugin/test/Main.hs b/plugins/hls-gadt-plugin/test/Main.hs index e92296eb0d..d36abc6347 100644 --- a/plugins/hls-gadt-plugin/test/Main.hs +++ b/plugins/hls-gadt-plugin/test/Main.hs @@ -35,14 +35,8 @@ tests = testGroup "GADT" , runTest "ConstructorContext" "ConstructorContext" 2 0 2 38 , runTest "Context" "Context" 2 0 4 41 , runTest "Pragma" "Pragma" 2 0 3 29 - , onlyWorkForGhcVersions (`elem`[GHC92, GHC94, GHC96]) "Single deriving has different output on ghc9.2+" $ - runTest "SingleDerivingGHC92" "SingleDerivingGHC92" 2 0 3 14 - , knownBrokenForGhcVersions [GHC92,GHC94,GHC96] "Single deriving has different output on ghc9.2+" $ - runTest "SingleDeriving" "SingleDeriving" 2 0 3 14 - , onlyWorkForGhcVersions (`elem`[GHC92, GHC94, GHC96]) "only ghc-9.2+ enabled GADTs pragma implicitly" $ - gadtPragmaTest "ghc-9.2 don't need to insert GADTs pragma" False - , knownBrokenForGhcVersions [GHC92,GHC94,GHC96] "ghc-9.2 has enabled GADTs pragma implicitly" $ - gadtPragmaTest "insert pragma" True + , runTest "SingleDerivingGHC92" "SingleDerivingGHC92" 2 0 3 14 + , gadtPragmaTest "ghc-9.2 don't need to insert GADTs pragma" False ] gadtPragmaTest :: TestName -> Bool -> TestTree diff --git a/plugins/hls-refactor-plugin/hls-refactor-plugin.cabal b/plugins/hls-refactor-plugin/hls-refactor-plugin.cabal index 8656d80fb3..7678c360c1 100644 --- a/plugins/hls-refactor-plugin/hls-refactor-plugin.cabal +++ b/plugins/hls-refactor-plugin/hls-refactor-plugin.cabal @@ -26,11 +26,6 @@ common warnings library import: warnings - -- Plugins that need exactprint have not been updated for 9.8 yet - if impl(ghc >= 9.8) - buildable: False - else - buildable: True exposed-modules: Development.IDE.GHC.ExactPrint Development.IDE.GHC.Compat.ExactPrint Development.IDE.Plugin.CodeAction @@ -102,10 +97,6 @@ library test-suite tests import: warnings - if impl(ghc >= 9.8) - buildable: False - else - buildable: True type: exitcode-stdio-1.0 default-language: Haskell2010 hs-source-dirs: test diff --git a/plugins/hls-refactor-plugin/src/Development/IDE/GHC/Dump.hs b/plugins/hls-refactor-plugin/src/Development/IDE/GHC/Dump.hs index 1d74197445..b19b972feb 100644 --- a/plugins/hls-refactor-plugin/src/Development/IDE/GHC/Dump.hs +++ b/plugins/hls-refactor-plugin/src/Development/IDE/GHC/Dump.hs @@ -123,7 +123,11 @@ showAstDataHtml a0 = html $ sourceText :: SourceText -> SDoc sourceText NoSourceText = text "NoSourceText" +#if MIN_VERSION_ghc(9,7,0) + sourceText (SourceText src) = text "SourceText" <+> ftext src +#else sourceText (SourceText src) = text "SourceText" <+> text src +#endif epaAnchor :: EpaLocation -> SDoc #if MIN_VERSION_ghc(9,5,0) diff --git a/plugins/hls-refactor-plugin/src/Development/IDE/Plugin/CodeAction.hs b/plugins/hls-refactor-plugin/src/Development/IDE/Plugin/CodeAction.hs index 8479d5803d..48c33ea07b 100644 --- a/plugins/hls-refactor-plugin/src/Development/IDE/Plugin/CodeAction.hs +++ b/plugins/hls-refactor-plugin/src/Development/IDE/Plugin/CodeAction.hs @@ -938,7 +938,11 @@ suggestExtendImport :: ExportsMap -> ParsedSource -> Diagnostic -> [(T.Text, Cod suggestExtendImport exportsMap (L _ HsModule {hsmodImports}) Diagnostic{_range=_range,..} | Just [binding, mod, srcspan] <- matchRegexUnifySpaces _message +#if MIN_VERSION_ghc(9,7,0) + "Add ‘([^’]*)’ to the import list in the import of ‘([^’]*)’ *\\(at (.*)\\)." +#else "Perhaps you want to add ‘([^’]*)’ to the import list in the import of ‘([^’]*)’ *\\((.*)\\)." +#endif = suggestions hsmodImports binding mod srcspan | Just (binding, mod_srcspan) <- matchRegExMultipleImports _message @@ -965,9 +969,13 @@ suggestExtendImport exportsMap (L _ HsModule {hsmodImports}) Diagnostic{_range=_ | otherwise = [] lookupExportMap binding mod | let em = getExportsMap exportsMap +#if MIN_VERSION_ghc(9,7,0) + match = mconcat $ lookupOccEnv_AllNameSpaces em (mkVarOrDataOcc binding) +#else match1 = lookupOccEnv em (mkVarOrDataOcc binding) match2 = lookupOccEnv em (mkTypeOcc binding) , Just match <- match1 <> match2 +#endif -- Only for the situation that data constructor name is same as type constructor name, -- let ident with parent be in front of the one without. , sortedMatch <- sortBy (\ident1 ident2 -> parent ident2 `compare` parent ident1) (Set.toList match) @@ -1165,9 +1173,20 @@ suggestFixConstructorImport Diagnostic{_range=_range,..} -- import Data.Aeson.Types( Result( Success ) ) -- or -- import Data.Aeson.Types( Result(..) ) (lsp-ui) + -- + -- On 9.8+ + -- + -- In the import of ‘ModuleA’: + -- an item called ‘Constructor’ + -- is exported, but it is a data constructor of + -- ‘A’. | Just [constructor, typ] <- matchRegexUnifySpaces _message +#if MIN_VERSION_ghc(9,7,0) + "an item called ‘([^’]*)’ is exported, but it is a data constructor of ‘([^’]*)’" +#else "‘([^’]*)’ is a data constructor of ‘([^’]*)’ To import it use" +#endif = let fixedImport = typ <> "(" <> constructor <> ")" in [("Fix import of " <> fixedImport, TextEdit _range fixedImport)] | otherwise = [] @@ -1434,7 +1453,11 @@ suggestNewImport df packageExportsMap ps fileContents Diagnostic{..} *> extractQualifiedModuleNameFromMissingName (extractTextInRange _range fileContents) , Just (range, indent) <- newImportInsertRange ps fileContents , extendImportSuggestions <- matchRegexUnifySpaces msg +#if MIN_VERSION_ghc(9,7,0) + "Add ‘[^’]*’ to the import list in the import of ‘([^’]*)’" +#else "Perhaps you want to add ‘[^’]*’ to the import list in the import of ‘([^’]*)’" +#endif = let qis = qualifiedImportStyle df -- FIXME: we can use thingMissing once the support for GHC 9.4 is dropped. -- In what fllows, @missing@ is assumed to be qualified name. @@ -1952,30 +1975,32 @@ regexSingleMatch msg regex = case matchRegexUnifySpaces msg regex of Just (h:_) -> Just h _ -> Nothing --- | Parses tuples like (‘Data.Map’, (app/ModuleB.hs:2:1-18)) and --- | return (Data.Map, app/ModuleB.hs:2:1-18) -regExPair :: (T.Text, T.Text) -> Maybe (T.Text, T.Text) -regExPair (modname, srcpair) = do - x <- regexSingleMatch modname "‘([^’]*)’" - y <- regexSingleMatch srcpair "\\((.*)\\)" - return (x, y) - -- | Process a list of (module_name, filename:src_span) values -- | Eg. [(Data.Map, app/ModuleB.hs:2:1-18), (Data.HashMap.Strict, app/ModuleB.hs:3:1-29)] regExImports :: T.Text -> Maybe [(T.Text, T.Text)] -regExImports msg = result - where - parts = T.words msg - isPrefix = not . T.isPrefixOf "(" - (mod, srcspan) = partition isPrefix parts - -- check we have matching pairs like (Data.Map, (app/src.hs:1:2-18)) - result = if length mod == length srcspan then - regExPair `traverse` zip mod srcspan - else Nothing +regExImports msg + | Just mods' <- allMatchRegex msg "‘([^’]*)’" + , Just srcspans' <- allMatchRegex msg +#if MIN_VERSION_ghc(9,7,0) + "\\(at ([^)]*)\\)" +#else + "\\(([^)]*)\\)" +#endif + , mods <- [mod | [_,mod] <- mods'] + , srcspans <- [srcspan | [_,srcspan] <- srcspans'] + -- check we have matching pairs like (Data.Map, (app/src.hs:1:2-18)) + , let result = if length mods == length srcspans then + Just (zip mods srcspans) else Nothing + = result + | otherwise = Nothing matchRegExMultipleImports :: T.Text -> Maybe (T.Text, [(T.Text, T.Text)]) matchRegExMultipleImports message = do +#if MIN_VERSION_ghc(9,7,0) + let pat = T.pack "Add ‘([^’]*)’ to one of these import lists: *(‘.*\\))$" +#else let pat = T.pack "Perhaps you want to add ‘([^’]*)’ to one of these import lists: *(‘.*\\))$" +#endif (binding, imports) <- case matchRegexUnifySpaces message pat of Just [x, xs] -> Just (x, xs) _ -> Nothing diff --git a/plugins/hls-refactor-plugin/src/Development/IDE/Plugin/CodeAction/ExactPrint.hs b/plugins/hls-refactor-plugin/src/Development/IDE/Plugin/CodeAction/ExactPrint.hs index 4c07354295..10327423e6 100644 --- a/plugins/hls-refactor-plugin/src/Development/IDE/Plugin/CodeAction/ExactPrint.hs +++ b/plugins/hls-refactor-plugin/src/Development/IDE/Plugin/CodeAction/ExactPrint.hs @@ -253,7 +253,13 @@ extendImportTopLevel thing (L l it@ImportDecl{..}) noExtField #endif rdr - x = reLocA $ L top $ IEVar noExtField lie + x = reLocA $ L top $ IEVar +#if MIN_VERSION_ghc(9,8,0) + Nothing -- no deprecated +#else + noExtField +#endif + lie if x `elem` lies then TransformT $ lift (Left $ thing <> " already imported") @@ -311,7 +317,13 @@ extendImportViaParent df parent child (L l it@ImportDecl{..}) noExtField #endif childRdr - x :: LIE GhcPs = L ll' $ IEThingWith (addAnns mempty [AddEpAnn AnnOpenP (EpaDelta (SameLine 1) []), AddEpAnn AnnCloseP def] emptyComments) absIE NoIEWildcard [childLIE] + x :: LIE GhcPs = L ll' $ IEThingWith +#if MIN_VERSION_ghc(9,7,0) + (Nothing, addAnns mempty [AddEpAnn AnnOpenP (EpaDelta (SameLine 1) []), AddEpAnn AnnCloseP def] emptyComments) +#else + (addAnns mempty [AddEpAnn AnnOpenP (EpaDelta (SameLine 1) []), AddEpAnn AnnCloseP def] emptyComments) +#endif + absIE NoIEWildcard [childLIE] #if MIN_VERSION_ghc(9,5,0) return $ L l it{ideclImportList = Just (hide, L l' $ reverse pre ++ [x] ++ xs)} @@ -329,7 +341,11 @@ extendImportViaParent df parent child (L l it@ImportDecl{..}) let it' = it{ideclHiding = Just (hide, lies)} #endif thing = IEThingWith newl twIE (IEWildcard 2) [] +#if MIN_VERSION_ghc(9,7,0) + newl = fmap (\ann -> ann ++ [(AddEpAnn AnnDotdot d0)]) <$> l''' +#else newl = (\ann -> ann ++ [(AddEpAnn AnnDotdot d0)]) <$> l''' +#endif lies = L l' $ reverse pre ++ [L l'' thing] ++ xs return $ L l it' | parent == unIEWrappedName ie @@ -382,7 +398,11 @@ extendImportViaParent df parent child (L l it@ImportDecl{..}) noExtField #endif childRdr +#if MIN_VERSION_ghc(9,7,0) + listAnn = (Nothing, epAnn srcParent [AddEpAnn AnnOpenP (epl 1), AddEpAnn AnnCloseP (epl 0)]) +#else listAnn = epAnn srcParent [AddEpAnn AnnOpenP (epl 1), AddEpAnn AnnCloseP (epl 0)] +#endif x :: LIE GhcPs = reLocA $ L l'' $ IEThingWith listAnn parentLIE NoIEWildcard [childLIE] lies' = addCommaInImportList (reverse pre) x @@ -486,7 +506,13 @@ extendHiding symbol (L l idecls) mlies df = do noExtField #endif rdr - x = reLocA $ L top $ IEVar noExtField lie + x = reLocA $ L top $ IEVar +#if MIN_VERSION_ghc(9,7,0) + Nothing +#else + noExtField +#endif + lie x <- pure $ if hasSibling then first addComma x else x lies <- pure $ over _head (`setEntryDP` SameLine 1) lies #if MIN_VERSION_ghc(9,5,0) diff --git a/plugins/hls-refactor-plugin/test/Main.hs b/plugins/hls-refactor-plugin/test/Main.hs index 4b0c41e423..28e163bc3f 100644 --- a/plugins/hls-refactor-plugin/test/Main.hs +++ b/plugins/hls-refactor-plugin/test/Main.hs @@ -1,5 +1,4 @@ {-# LANGUAGE AllowAmbiguousTypes #-} -{-# LANGUAGE CPP #-} {-# LANGUAGE DataKinds #-} {-# LANGUAGE DuplicateRecordFields #-} {-# LANGUAGE GADTs #-} @@ -701,7 +700,9 @@ typeWildCardActionTests = testGroup "type wildcard actions" [ "func :: _" , "func x y = x + y" ] - [ "func :: Integer -> Integer -> Integer" + [ if ghcVersion >= GHC98 + then "func :: a -> a -> a" -- 9.8 has a different suggestion + else "func :: Integer -> Integer -> Integer" , "func x y = x + y" ] , testUseTypeSignature "type in parentheses" @@ -729,7 +730,9 @@ typeWildCardActionTests = testGroup "type wildcard actions" [ "func::_" , "func x y = x + y" ] - [ "func::Integer -> Integer -> Integer" + [ if ghcVersion >= GHC98 + then "func::a -> a -> a" -- 9.8 has a different suggestion + else "func::Integer -> Integer -> Integer" , "func x y = x + y" ] , testGroup "add parens if hole is part of bigger type" @@ -1665,6 +1668,7 @@ suggestImportTests :: TestTree suggestImportTests = testGroup "suggest import actions" [ testGroup "Dont want suggestion" [ -- extend import + -- We don't want to suggest a new import, but extend existing imports test False ["Data.List.NonEmpty ()"] "f = nonEmpty" [] "import Data.List.NonEmpty (nonEmpty)" -- data constructor , test False [] "f = First" [] "import Data.Monoid (First)" @@ -3732,12 +3736,15 @@ extendImportTestsRegEx = testGroup "regex parsing" "\n\8226 Perhaps you want to add \8216fromList\8217 to one of these import lists:\n \8216Data.Map\8217)" Nothing , testCase "parse multiple imports" $ template - "\n\8226 Perhaps you want to add \8216fromList\8217 to one of these import lists:\n \8216Data.Map\8217 (app/testlsp.hs:7:1-18)\n \8216Data.HashMap.Strict\8217 (app/testlsp.hs:8:1-29)" + (if ghcVersion >= GHC98 + then "\n\8226 Add \8216fromList\8217 to one of these import lists:\n \8216Data.Map\8217 (at app/testlsp.hs:7:1-18)\n \8216Data.HashMap.Strict\8217 (at app/testlsp.hs:8:1-29)" + else "\n\8226 Perhaps you want to add \8216fromList\8217 to one of these import lists:\n \8216Data.Map\8217 (app/testlsp.hs:7:1-18)\n \8216Data.HashMap.Strict\8217 (app/testlsp.hs:8:1-29)" + ) $ Just ("fromList",[("Data.Map","app/testlsp.hs:7:1-18"),("Data.HashMap.Strict","app/testlsp.hs:8:1-29")]) ] where template message expected = do - liftIO $ matchRegExMultipleImports message @=? expected + liftIO $ expected @=? matchRegExMultipleImports message pickActionWithTitle :: T.Text -> [Command |? CodeAction] -> IO CodeAction pickActionWithTitle title actions = do diff --git a/plugins/hls-rename-plugin/hls-rename-plugin.cabal b/plugins/hls-rename-plugin/hls-rename-plugin.cabal index 31f04f4566..f78f7f96b9 100644 --- a/plugins/hls-rename-plugin/hls-rename-plugin.cabal +++ b/plugins/hls-rename-plugin/hls-rename-plugin.cabal @@ -21,11 +21,6 @@ source-repository head location: https://github.com/haskell/haskell-language-server.git library - -- Plugins that need exactprint have not been updated for 9.8 yet - if impl(ghc >= 9.8) - buildable: False - else - buildable: True exposed-modules: Ide.Plugin.Rename hs-source-dirs: src build-depends: @@ -53,10 +48,6 @@ library default-language: Haskell2010 test-suite tests - if impl(ghc >= 9.8) - buildable: False - else - buildable: True type: exitcode-stdio-1.0 default-language: Haskell2010 hs-source-dirs: test diff --git a/plugins/hls-retrie-plugin/hls-retrie-plugin.cabal b/plugins/hls-retrie-plugin/hls-retrie-plugin.cabal index 1409cccd81..20f4794c44 100644 --- a/plugins/hls-retrie-plugin/hls-retrie-plugin.cabal +++ b/plugins/hls-retrie-plugin/hls-retrie-plugin.cabal @@ -21,11 +21,6 @@ source-repository head location: https://github.com/haskell/haskell-language-server.git library - -- Plugins that need exactprint have not been updated for 9.8 yet - if impl(ghc >= 9.8) - buildable: False - else - buildable: True exposed-modules: Ide.Plugin.Retrie hs-source-dirs: src build-depends: @@ -60,10 +55,6 @@ library ghc-options: -Wno-unticked-promoted-constructors test-suite tests - if impl(ghc >= 9.8) - buildable: False - else - buildable: True type: exitcode-stdio-1.0 default-language: Haskell2010 hs-source-dirs: test diff --git a/plugins/hls-splice-plugin/hls-splice-plugin.cabal b/plugins/hls-splice-plugin/hls-splice-plugin.cabal index 1405219435..571fa43103 100644 --- a/plugins/hls-splice-plugin/hls-splice-plugin.cabal +++ b/plugins/hls-splice-plugin/hls-splice-plugin.cabal @@ -27,11 +27,6 @@ source-repository head location: https://github.com/haskell/haskell-language-server.git library - -- Plugins that need exactprint have not been updated for 9.8 yet - if impl(ghc >= 9.8) - buildable: False - else - buildable: True exposed-modules: Ide.Plugin.Splice Ide.Plugin.Splice.Types @@ -66,10 +61,6 @@ library TypeOperators test-suite tests - if impl(ghc >= 9.8) - buildable: False - else - buildable: True type: exitcode-stdio-1.0 default-language: Haskell2010 hs-source-dirs: test diff --git a/test/testdata/schema/ghc98/default-config.golden.json b/test/testdata/schema/ghc98/default-config.golden.json index 7e8aacb406..b42d8f4e51 100644 --- a/test/testdata/schema/ghc98/default-config.golden.json +++ b/test/testdata/schema/ghc98/default-config.golden.json @@ -18,6 +18,10 @@ "changeTypeSignature": { "globalOn": true }, + "class": { + "codeActionsOn": true, + "codeLensOn": true + }, "eval": { "config": { "diff": true, @@ -37,6 +41,21 @@ "path": "fourmolu" } }, + "gadt": { + "globalOn": true + }, + "ghcide-code-actions-bindings": { + "globalOn": true + }, + "ghcide-code-actions-fill-holes": { + "globalOn": true + }, + "ghcide-code-actions-imports-exports": { + "globalOn": true + }, + "ghcide-code-actions-type-signatures": { + "globalOn": true + }, "ghcide-completions": { "config": { "autoExtendOn": true, @@ -81,6 +100,15 @@ "qualifyImportedNames": { "globalOn": true }, + "rename": { + "config": { + "crossModule": false + }, + "globalOn": true + }, + "retrie": { + "globalOn": true + }, "semanticTokens": { "config": { "classMethodToken": "method", @@ -97,6 +125,9 @@ }, "globalOn": false }, + "splice": { + "globalOn": true + }, "stan": { "globalOn": false } diff --git a/test/testdata/schema/ghc98/vscode-extension-schema.golden.json b/test/testdata/schema/ghc98/vscode-extension-schema.golden.json index 9987252694..861b8a37e0 100644 --- a/test/testdata/schema/ghc98/vscode-extension-schema.golden.json +++ b/test/testdata/schema/ghc98/vscode-extension-schema.golden.json @@ -35,6 +35,18 @@ "scope": "resource", "type": "boolean" }, + "haskell.plugin.class.codeActionsOn": { + "default": true, + "description": "Enables class code actions", + "scope": "resource", + "type": "boolean" + }, + "haskell.plugin.class.codeLensOn": { + "default": true, + "description": "Enables class code lenses", + "scope": "resource", + "type": "boolean" + }, "haskell.plugin.eval.config.diff": { "default": true, "markdownDescription": "Enable the diff output (WAS/NOW) of eval lenses", @@ -77,6 +89,36 @@ "scope": "resource", "type": "string" }, + "haskell.plugin.gadt.globalOn": { + "default": true, + "description": "Enables gadt plugin", + "scope": "resource", + "type": "boolean" + }, + "haskell.plugin.ghcide-code-actions-bindings.globalOn": { + "default": true, + "description": "Enables ghcide-code-actions-bindings plugin", + "scope": "resource", + "type": "boolean" + }, + "haskell.plugin.ghcide-code-actions-fill-holes.globalOn": { + "default": true, + "description": "Enables ghcide-code-actions-fill-holes plugin", + "scope": "resource", + "type": "boolean" + }, + "haskell.plugin.ghcide-code-actions-imports-exports.globalOn": { + "default": true, + "description": "Enables ghcide-code-actions-imports-exports plugin", + "scope": "resource", + "type": "boolean" + }, + "haskell.plugin.ghcide-code-actions-type-signatures.globalOn": { + "default": true, + "description": "Enables ghcide-code-actions-type-signatures plugin", + "scope": "resource", + "type": "boolean" + }, "haskell.plugin.ghcide-completions.config.autoExtendOn": { "default": true, "markdownDescription": "Extends the import list automatically when completing a out-of-scope identifier", @@ -183,6 +225,24 @@ "scope": "resource", "type": "boolean" }, + "haskell.plugin.rename.config.crossModule": { + "default": false, + "markdownDescription": "Enable experimental cross-module renaming", + "scope": "resource", + "type": "boolean" + }, + "haskell.plugin.rename.globalOn": { + "default": true, + "description": "Enables rename plugin", + "scope": "resource", + "type": "boolean" + }, + "haskell.plugin.retrie.globalOn": { + "default": true, + "description": "Enables retrie plugin", + "scope": "resource", + "type": "boolean" + }, "haskell.plugin.semanticTokens.config.classMethodToken": { "default": "method", "description": "LSP semantic token type to use for typeclass methods", @@ -805,6 +865,12 @@ "scope": "resource", "type": "boolean" }, + "haskell.plugin.splice.globalOn": { + "default": true, + "description": "Enables splice plugin", + "scope": "resource", + "type": "boolean" + }, "haskell.plugin.stan.globalOn": { "default": false, "description": "Enables stan plugin",