diff --git a/.github/workflows/supported-ghc-versions.json b/.github/workflows/supported-ghc-versions.json index 0bccbd7e47..eee26fd884 100644 --- a/.github/workflows/supported-ghc-versions.json +++ b/.github/workflows/supported-ghc-versions.json @@ -1 +1 @@ -[ "9.6", "9.4" , "9.2" , "9.0" ] +[ "9.8", "9.6", "9.4" , "9.2" , "9.0" ] diff --git a/.github/workflows/test.yml b/.github/workflows/test.yml index ed63e13dfd..b5180353b2 100644 --- a/.github/workflows/test.yml +++ b/.github/workflows/test.yml @@ -135,15 +135,15 @@ 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 + - if: matrix.test && !startsWith(matrix.ghc,'9.8') name: Test hls-refactor-plugin run: cabal test hls-refactor-plugin --test-options="$TEST_OPTS" || cabal test hls-refactor-plugin --test-options="$TEST_OPTS" - - if: matrix.test && matrix.ghc != '9.6' + - if: matrix.test && matrix.ghc != '9.6' && !startsWith(matrix.ghc,'9.8') 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 + - if: matrix.test && !startsWith(matrix.ghc,'9.8') 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,19 +155,19 @@ 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 + - if: matrix.test && !startsWith(matrix.ghc,'9.8') name: Test hls-splice-plugin run: cabal test hls-splice-plugin --test-options="$TEST_OPTS" || cabal test hls-splice-plugin --test-options="$TEST_OPTS" - - if: matrix.test + - if: matrix.test && !startsWith(matrix.ghc,'9.8') name: Test hls-stylish-haskell-plugin run: cabal test hls-stylish-haskell-plugin --test-options="$TEST_OPTS" || cabal test hls-stylish-haskell-plugin --test-options="$TEST_OPTS" - - if: matrix.test + - if: matrix.test && !startsWith(matrix.ghc,'9.8') name: Test hls-ormolu-plugin run: cabal test hls-ormolu-plugin --test-options="$TEST_OPTS" || cabal test hls-ormolu-plugin --test-options="$TEST_OPTS" - - if: matrix.test + - if: matrix.test && !startsWith(matrix.ghc,'9.8') name: Test hls-fourmolu-plugin run: cabal test hls-fourmolu-plugin --test-options="$TEST_OPTS" || cabal test hls-fourmolu-plugin --test-options="$TEST_OPTS" @@ -179,11 +179,11 @@ 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' + - if: matrix.test && matrix.os != 'windows-latest' && !startsWith(matrix.ghc,'9.8') 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" - - if: matrix.test + - if: matrix.test && !startsWith(matrix.ghc,'9.8') name: Test hls-hlint-plugin test suite run: cabal test hls-hlint-plugin --test-options="$TEST_OPTS" || cabal test hls-hlint-plugin --test-options="$TEST_OPTS" @@ -207,7 +207,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 + - if: matrix.test && !startsWith(matrix.ghc,'9.8') 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" @@ -228,7 +228,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 + - if: matrix.test && !startsWith(matrix.ghc,'9.8') 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/cabal.project b/cabal.project index 8103682aed..00c983b81b 100644 --- a/cabal.project +++ b/cabal.project @@ -52,7 +52,7 @@ package * write-ghc-environment-files: never -index-state: 2023-09-08T00:00:00Z +index-state: 2023-10-06T06:12:29Z constraints: -- For GHC 9.4, older versions of entropy fail to build on Windows @@ -101,3 +101,32 @@ if impl(ghc >= 9.5) -- ghc-9.6 ekg-core:ghc-prim, stm-hamt:transformers, + +if impl(ghc >= 9.7) + allow-newer: + -- ghc-9.8 + base, + template-haskell, + ghc, + ghc-prim, + integer-gmp, + ghc-bignum, + template-haskell, + text, + binary, + bytestring, + Cabal, + unix, + deepseq, + +if impl(ghc >= 9.7) + repository head.hackage.ghc.haskell.org + url: https://ghc.gitlab.haskell.org/head.hackage/ + secure: True + key-threshold: 3 + root-keys: + f76d08be13e9a61a377a85e2fb63f4c5435d40f8feb3e12eb05905edb8cdea89 + 26021a13b401500c8eb2761ca95c61f2d625bfef951b939a8124ed12ecf07329 + 7541f32a4ccca4f97aea3b22f5e593ba2c0267546016b992dfadcd2fe944e55d + + active-repositories: hackage.haskell.org, head.hackage.ghc.haskell.org diff --git a/ghcide/ghcide.cabal b/ghcide/ghcide.cabal index 523857928c..6840b52349 100644 --- a/ghcide/ghcide.cabal +++ b/ghcide/ghcide.cabal @@ -59,7 +59,7 @@ library dependent-sum, dlist, exceptions, - extra >= 1.7.4, + extra >= 1.7.14, enummapset, filepath, fingertree, diff --git a/ghcide/session-loader/Development/IDE/Session.hs b/ghcide/session-loader/Development/IDE/Session.hs index 46e41072cd..c1225a4f40 100644 --- a/ghcide/session-loader/Development/IDE/Session.hs +++ b/ghcide/session-loader/Development/IDE/Session.hs @@ -40,6 +40,8 @@ import Data.Function import Data.Hashable hiding (hash) import qualified Data.HashMap.Strict as HM import Data.List +import qualified Data.List.NonEmpty as NE +import Data.List.NonEmpty (NonEmpty(..)) import qualified Data.Map.Strict as Map import Data.Maybe import Data.Proxy @@ -520,9 +522,9 @@ loadSessionWithOptions recorder SessionLoadingOptions{..} dir = do -- information. new_deps = RawComponentInfo (homeUnitId_ df) df targets cfp opts dep_info - : maybe [] snd oldDeps + :| maybe [] snd oldDeps -- Get all the unit-ids for things in this component - inplace = map rawComponentUnitId new_deps + inplace = map rawComponentUnitId $ NE.toList new_deps new_deps' <- forM new_deps $ \RawComponentInfo{..} -> do -- Remove all inplace dependencies from package flags for @@ -572,7 +574,7 @@ loadSessionWithOptions recorder SessionLoadingOptions{..} dir = do -- . The information for the new component which caused this cache miss -- . The modified information (without -inplace flags) for -- existing packages - pure (Map.insert hieYaml (newHscEnv, new_deps) m, (newHscEnv, head new_deps', tail new_deps')) + pure (Map.insert hieYaml (newHscEnv, NE.toList new_deps) m, (newHscEnv, NE.head new_deps', NE.tail new_deps')) let session :: (Maybe FilePath, NormalizedFilePath, ComponentOptions, FilePath) diff --git a/ghcide/src/Development/IDE/Core/Compile.hs b/ghcide/src/Development/IDE/Core/Compile.hs index b47c28742d..bbaf3d036e 100644 --- a/ghcide/src/Development/IDE/Core/Compile.hs +++ b/ghcide/src/Development/IDE/Core/Compile.hs @@ -73,7 +73,7 @@ import Data.Time (UTCTime (..)) import Data.Tuple.Extra (dupe) import Data.Unique as Unique import Debug.Trace -import Development.IDE.Core.FileStore (resetInterfaceStore, shareFilePath) +import Development.IDE.Core.FileStore (resetInterfaceStore) import Development.IDE.Core.Preprocessor import Development.IDE.Core.RuleTypes import Development.IDE.Core.Shake @@ -147,6 +147,13 @@ import GHC.Driver.Config.CoreToStg.Prep import GHC.Core.Lint.Interactive #endif +#if MIN_VERSION_ghc(9,7,0) +import Data.Foldable (toList) +import GHC.Unit.Module.Warnings +#else +import Development.IDE.Core.FileStore (shareFilePath) +#endif + --Simple constants to make sure the source is consistently named sourceTypecheck :: T.Text sourceTypecheck = "typecheck" @@ -479,11 +486,16 @@ filterUsages = id -- Important to do this immediately after reading the unit before -- anything else has a chance to read `mi_usages` shareUsages :: ModIface -> ModIface -shareUsages iface = iface {mi_usages = usages} +shareUsages iface + = iface +-- Fixed upstream in GHC 9.8 +#if !MIN_VERSION_ghc(9,7,0) + {mi_usages = usages} where usages = map go (mi_usages iface) go usg@UsageFile{} = usg {usg_file_path = fp} where !fp = shareFilePath (usg_file_path usg) go usg = usg +#endif mkHiFileResultNoCompile :: HscEnv -> TcModuleResult -> IO HiFileResult @@ -646,11 +658,24 @@ compileModule (RunSimplifier simplify) session ms tcg = fmap (either (, Nothing) (second Just)) $ catchSrcErrors (hsc_dflags session) "compile" $ do (warnings,desugared_guts) <- withWarnings "compile" $ \tweak -> do - let session' = tweak (hscSetFlags (ms_hspp_opts ms) session) + -- Breakpoints don't survive roundtripping from disk + -- and this trips up the verify-core-files check + -- They may also lead to other problems. + -- We have to setBackend ghciBackend in 9.8 as otherwise + -- non-exported definitions are stripped out. + -- However, setting this means breakpoints are generated. + -- Solution: prevent breakpoing generation by unsetting + -- Opt_InsertBreakpoints + let session' = tweak $ flip hscSetFlags session +#if MIN_VERSION_ghc(9,7,0) + $ flip gopt_unset Opt_InsertBreakpoints + $ setBackend ghciBackend +#endif + $ ms_hspp_opts ms -- TODO: maybe settings ms_hspp_opts is unnecessary? -- MP: the flags in ModSummary should be right, if they are wrong then -- the correct place to fix this is when the ModSummary is created. - desugar <- hscDesugar session' (ms { ms_hspp_opts = hsc_dflags session' }) tcg + desugar <- hscDesugar session' (ms { ms_hspp_opts = hsc_dflags session' }) tcg if simplify then do plugins <- readIORef (tcg_th_coreplugins tcg) @@ -779,23 +804,41 @@ unnecessaryDeprecationWarningFlags , Opt_WarnUnusedForalls , Opt_WarnUnusedRecordWildcards , Opt_WarnInaccessibleCode +#if !MIN_VERSION_ghc(9,7,0) , Opt_WarnWarningsDeprecations +#endif ] -- | Add a unnecessary/deprecated tag to the required diagnostics. #if MIN_VERSION_ghc(9,3,0) tagDiag :: (Maybe DiagnosticReason, FileDiagnostic) -> (Maybe DiagnosticReason, FileDiagnostic) -tagDiag (w@(Just (WarningWithFlag warning)), (nfp, sh, fd)) #else tagDiag :: (WarnReason, FileDiagnostic) -> (WarnReason, FileDiagnostic) -tagDiag (w@(Reason warning), (nfp, sh, fd)) #endif + +#if MIN_VERSION_ghc(9,7,0) +tagDiag (w@(Just (WarningWithCategory cat)), (nfp, sh, fd)) + | cat == defaultWarningCategory -- default warning category is for deprecations + = (w, (nfp, sh, fd { _tags = Just $ DiagnosticTag_Deprecated : concat (_tags fd) })) +tagDiag (w@(Just (WarningWithFlags warnings)), (nfp, sh, fd)) + | tags <- mapMaybe requiresTag (toList warnings) + = (w, (nfp, sh, fd { _tags = Just $ tags ++ concat (_tags fd) })) +#elif MIN_VERSION_ghc(9,3,0) +tagDiag (w@(Just (WarningWithFlag warning)), (nfp, sh, fd)) + | Just tag <- requiresTag warning + = (w, (nfp, sh, fd { _tags = Just $ tag : concat (_tags fd) })) +#else +tagDiag (w@(Reason warning), (nfp, sh, fd)) | Just tag <- requiresTag warning = (w, (nfp, sh, fd { _tags = Just $ tag : concat (_tags fd) })) +#endif where requiresTag :: WarningFlag -> Maybe DiagnosticTag +#if !MIN_VERSION_ghc(9,7,0) + -- doesn't exist on 9.8, we use WarningWithCategory instead requiresTag Opt_WarnWarningsDeprecations = Just DiagnosticTag_Deprecated +#endif requiresTag wflag -- deprecation was already considered above | wflag `elem` unnecessaryDeprecationWarningFlags = Just DiagnosticTag_Unnecessary diff --git a/ghcide/src/Development/IDE/GHC/CPP.hs b/ghcide/src/Development/IDE/GHC/CPP.hs index 5bc7530aac..2d816a562c 100644 --- a/ghcide/src/Development/IDE/GHC/CPP.hs +++ b/ghcide/src/Development/IDE/GHC/CPP.hs @@ -52,8 +52,12 @@ doCpp env input_fn output_fn = #if MIN_VERSION_ghc(9,5,0) let cpp_opts = Pipeline.CppOpts - { cppUseCc = False - , cppLinePragmas = True + { cppLinePragmas = True +# if MIN_VERSION_ghc(9,9,0) + , useHsCpp = True +# else + , cppUseCc = False +# endif } in #else let cpp_opts = True in diff --git a/ghcide/src/Development/IDE/GHC/Compat.hs b/ghcide/src/Development/IDE/GHC/Compat.hs index 5e58e88975..2b2392af32 100644 --- a/ghcide/src/Development/IDE/GHC/Compat.hs +++ b/ghcide/src/Development/IDE/GHC/Compat.hs @@ -41,6 +41,8 @@ module Development.IDE.GHC.Compat( Usage(..), + liftZonkM, + FastStringCompat, bytesFS, mkFastStringByteString, @@ -55,6 +57,7 @@ module Development.IDE.GHC.Compat( combineRealSrcSpans, nonDetOccEnvElts, + nonDetFoldOccEnv, isQualifiedImport, GhcVersion(..), @@ -93,6 +96,7 @@ module Development.IDE.GHC.Compat( simplifyExpr, tidyExpr, emptyTidyEnv, + tcInitTidyEnv, corePrepExpr, corePrepPgm, lintInteractiveExpr, @@ -165,6 +169,9 @@ import qualified Data.Set as S -- See Note [Guidelines For Using CPP In GHCIDE Import Statements] +#if MIN_VERSION_ghc(9,7,0) +import GHC.Tc.Zonk.TcType (tcInitTidyEnv) +#endif import qualified GHC.Core.Opt.Pipeline as GHC import GHC.Core.Tidy (tidyExpr) import GHC.CoreToStg.Prep (corePrepPgm) @@ -247,6 +254,15 @@ import GHC.Driver.Config.CoreToStg (initCoreTo import GHC.Driver.Config.CoreToStg.Prep (initCorePrepConfig) #endif +#if !MIN_VERSION_ghc(9,7,0) +liftZonkM :: a -> a +liftZonkM = id +#endif + +#if !MIN_VERSION_ghc(9,7,0) +nonDetFoldOccEnv :: (a -> b -> b) -> b -> OccEnv a -> b +nonDetFoldOccEnv = foldOccEnv +#endif #if !MIN_VERSION_ghc(9,3,0) nonDetOccEnvElts :: OccEnv a -> [a] @@ -328,7 +344,9 @@ myCoreToStg logger dflags ictxt #endif this_mod ml prepd_binds -#if MIN_VERSION_ghc(9,4,2) +#if MIN_VERSION_ghc(9,8,0) + (unzip -> (stg_binds2,_),_) +#elif MIN_VERSION_ghc(9,4,2) (stg_binds2,_) #else stg_binds2 @@ -537,13 +555,16 @@ data GhcVersion | GHC92 | GHC94 | GHC96 + | GHC98 deriving (Eq, Ord, Show) ghcVersionStr :: String ghcVersionStr = VERSION_ghc ghcVersion :: GhcVersion -#if MIN_VERSION_GLASGOW_HASKELL(9,6,0,0) +#if MIN_VERSION_GLASGOW_HASKELL(9,8,0,0) +ghcVersion = GHC98 +#elif MIN_VERSION_GLASGOW_HASKELL(9,6,0,0) ghcVersion = GHC96 #elif MIN_VERSION_GLASGOW_HASKELL(9,4,0,0) ghcVersion = GHC94 diff --git a/ghcide/src/Development/IDE/GHC/Compat/Core.hs b/ghcide/src/Development/IDE/GHC/Compat/Core.hs index bee32cbfd4..70619e5081 100644 --- a/ghcide/src/Development/IDE/GHC/Compat/Core.hs +++ b/ghcide/src/Development/IDE/GHC/Compat/Core.hs @@ -152,7 +152,9 @@ module Development.IDE.GHC.Compat.Core ( pattern AvailTC, Avail.availName, Avail.availNames, +#if !MIN_VERSION_ghc(9,7,0) Avail.availNamesWithSelectors, +#endif Avail.availsToNameSet, -- * TcGblEnv TcGblEnv(..), @@ -376,7 +378,9 @@ module Development.IDE.GHC.Compat.Core ( module GHC.Types.Name.Reader, module GHC.Utils.Error, #if MIN_VERSION_ghc(9,2,0) +#if !MIN_VERSION_ghc(9,7,0) module GHC.Types.Avail, +#endif module GHC.Types.SourceFile, module GHC.Types.SourceText, module GHC.Types.TyThing, @@ -556,7 +560,9 @@ import GHC.Parser.Lexer hiding (initParserState, getPsMess import GHC.Parser.Annotation (EpAnn (..)) import GHC.Platform.Ways import GHC.Runtime.Context (InteractiveImport (..)) +#if !MIN_VERSION_ghc(9,7,0) import GHC.Types.Avail (greNamePrintableName) +#endif import GHC.Types.Fixity (LexicalFixity (..), Fixity (..), defaultFixity) import GHC.Types.Meta import GHC.Types.Name.Set @@ -631,7 +637,9 @@ pattern RealSrcLoc x y = SrcLoc.RealSrcLoc x y pattern AvailTC :: Name -> [Name] -> [FieldLabel] -> Avail.AvailInfo -#if __GLASGOW_HASKELL__ >= 902 +#if __GLASGOW_HASKELL__ >= 907 +pattern AvailTC n names pieces <- Avail.AvailTC n ((,[]) -> (names,pieces)) +#elif __GLASGOW_HASKELL__ >= 902 pattern AvailTC n names pieces <- Avail.AvailTC n ((\gres -> foldr (\gre (names, pieces) -> case gre of Avail.NormalGreName name -> (name: names, pieces) Avail.FieldGreName label -> (names, label:pieces)) ([], []) gres) -> (names, pieces)) @@ -640,14 +648,18 @@ pattern AvailTC n names pieces <- Avail.AvailTC n names pieces #endif pattern AvailName :: Name -> Avail.AvailInfo -#if __GLASGOW_HASKELL__ >= 902 +#if __GLASGOW_HASKELL__ >= 907 +pattern AvailName n <- Avail.Avail n +#elif __GLASGOW_HASKELL__ >= 902 pattern AvailName n <- Avail.Avail (Avail.NormalGreName n) #else pattern AvailName n <- Avail.Avail n #endif pattern AvailFL :: FieldLabel -> Avail.AvailInfo -#if __GLASGOW_HASKELL__ >= 902 +#if __GLASGOW_HASKELL__ >= 907 +pattern AvailFL fl <- (const Nothing -> Just fl) -- this pattern always fails as this field was removed in 9.7 +#elif __GLASGOW_HASKELL__ >= 902 pattern AvailFL fl <- Avail.Avail (Avail.FieldGreName fl) #else -- pattern synonym that is never populated @@ -835,7 +847,11 @@ pattern GRE :: Name -> Parent -> Bool -> [ImportSpec] -> RdrName.GlobalRdrElt {-# COMPLETE GRE #-} #if MIN_VERSION_ghc(9,2,0) pattern GRE{gre_name, gre_par, gre_lcl, gre_imp} <- RdrName.GRE +#if MIN_VERSION_ghc(9,7,0) + {gre_name = gre_name +#else {gre_name = (greNamePrintableName -> gre_name) +#endif ,gre_par, gre_lcl, gre_imp = (toList -> gre_imp)} #else pattern GRE{gre_name, gre_par, gre_lcl, gre_imp} = RdrName.GRE{..} diff --git a/ghcide/src/Development/IDE/GHC/Compat/Env.hs b/ghcide/src/Development/IDE/GHC/Compat/Env.hs index 4c5e14c757..c1bb5a6aab 100644 --- a/ghcide/src/Development/IDE/GHC/Compat/Env.hs +++ b/ghcide/src/Development/IDE/GHC/Compat/Env.hs @@ -50,6 +50,7 @@ module Development.IDE.GHC.Compat.Env ( -- * Backend, backwards compatible Backend, setBackend, + ghciBackend, Development.IDE.GHC.Compat.Env.platformDefaultBackend, ) where @@ -274,6 +275,15 @@ setWays newWays flags = type Backend = HscTarget #endif +ghciBackend :: Backend +#if MIN_VERSION_ghc(9,6,0) +ghciBackend = interpreterBackend +#elif MIN_VERSION_ghc(9,2,0) +ghciBackend = Interpreter +#else +ghciBackend = HscInterpreted +#endif + platformDefaultBackend :: DynFlags -> Backend platformDefaultBackend = #if MIN_VERSION_ghc(9,2,0) diff --git a/ghcide/src/Development/IDE/GHC/Compat/Iface.hs b/ghcide/src/Development/IDE/GHC/Compat/Iface.hs index f2c5bc4222..1feeafa8b4 100644 --- a/ghcide/src/Development/IDE/GHC/Compat/Iface.hs +++ b/ghcide/src/Development/IDE/GHC/Compat/Iface.hs @@ -12,6 +12,11 @@ import GHC -- See Note [Guidelines For Using CPP In GHCIDE Import Statements] +#if MIN_VERSION_ghc(9,7,0) +import GHC.Iface.Errors.Ppr (missingInterfaceErrorDiagnostic) +import GHC.Iface.Errors.Types (IfaceMessage) +#endif + #if !MIN_VERSION_ghc(9,2,0) import qualified GHC.Driver.Finder as Finder import GHC.Driver.Types (FindResult) @@ -38,7 +43,9 @@ writeIfaceFile env = Iface.writeIface (hsc_dflags env) cannotFindModule :: HscEnv -> ModuleName -> FindResult -> SDoc cannotFindModule env modname fr = -#if MIN_VERSION_ghc(9,2,0) +#if MIN_VERSION_ghc(9,7,0) + missingInterfaceErrorDiagnostic (defaultDiagnosticOpts @IfaceMessage) $ Iface.cannotFindModule env modname fr +#elif MIN_VERSION_ghc(9,2,0) Iface.cannotFindModule env modname fr #else Finder.cannotFindModule (hsc_dflags env) modname fr diff --git a/ghcide/src/Development/IDE/GHC/Compat/Logger.hs b/ghcide/src/Development/IDE/GHC/Compat/Logger.hs index 1b553c5cae..a8ad157b77 100644 --- a/ghcide/src/Development/IDE/GHC/Compat/Logger.hs +++ b/ghcide/src/Development/IDE/GHC/Compat/Logger.hs @@ -51,7 +51,9 @@ type LogActionCompat = LogFlags -> Maybe DiagnosticReason -> Maybe Severity -> S -- alwaysQualify seems to still do the right thing here, according to the "unqualified warnings" test. logActionCompat :: LogActionCompat -> LogAction -#if MIN_VERSION_ghc(9,5,0) +#if MIN_VERSION_ghc(9,7,0) +logActionCompat logAction logFlags (MCDiagnostic severity (ResolvedDiagnosticReason wr) _) loc = logAction logFlags (Just wr) (Just severity) loc alwaysQualify +#elif MIN_VERSION_ghc(9,5,0) logActionCompat logAction logFlags (MCDiagnostic severity wr _) loc = logAction logFlags (Just wr) (Just severity) loc alwaysQualify #else logActionCompat logAction logFlags (MCDiagnostic severity wr) loc = logAction logFlags (Just wr) (Just severity) loc alwaysQualify diff --git a/ghcide/src/Development/IDE/GHC/Compat/Outputable.hs b/ghcide/src/Development/IDE/GHC/Compat/Outputable.hs index 25ae8f961a..40810d5830 100644 --- a/ghcide/src/Development/IDE/GHC/Compat/Outputable.hs +++ b/ghcide/src/Development/IDE/GHC/Compat/Outputable.hs @@ -19,6 +19,10 @@ module Development.IDE.GHC.Compat.Outputable ( #if MIN_VERSION_ghc(9,5,0) defaultDiagnosticOpts, GhcMessage, + DriverMessage, + Messages, + initDiagOpts, + pprMessages, #endif #if MIN_VERSION_ghc(9,3,0) DiagnosticReason(..), @@ -67,6 +71,9 @@ import GHC.Driver.Env import GHC.Driver.Ppr import GHC.Driver.Session import qualified GHC.Types.Error as Error +#if MIN_VERSION_ghc(9,7,0) +import GHC.Types.Error (defaultDiagnosticOpts) +#endif import GHC.Types.Name.Ppr import GHC.Types.Name.Reader import GHC.Types.SourceError @@ -89,7 +96,7 @@ import GHC.Parser.Errors.Types #endif #if MIN_VERSION_ghc(9,5,0) -import GHC.Driver.Errors.Types (GhcMessage) +import GHC.Driver.Errors.Types (GhcMessage, DriverMessage) #endif #if MIN_VERSION_ghc(9,5,0) @@ -169,12 +176,14 @@ pprNoLocMsgEnvelope :: Error.RenderableDiagnostic e => MsgEnvelope e -> SDoc #endif pprNoLocMsgEnvelope (MsgEnvelope { errMsgDiagnostic = e , errMsgContext = unqual }) - = sdocWithContext $ \ctx -> + = sdocWithContext $ \_ctx -> withErrStyle unqual $ -#if MIN_VERSION_ghc(9,3,0) - (formatBulleted ctx $ e) +#if MIN_VERSION_ghc(9,7,0) + (formatBulleted e) +#elif MIN_VERSION_ghc(9,3,0) + (formatBulleted _ctx $ e) #else - (formatBulleted ctx $ Error.renderDiagnostic e) + (formatBulleted _ctx $ Error.renderDiagnostic e) #endif #else diff --git a/ghcide/src/Development/IDE/GHC/Orphans.hs b/ghcide/src/Development/IDE/GHC/Orphans.hs index 57f8b0bd00..61e13a855c 100644 --- a/ghcide/src/Development/IDE/GHC/Orphans.hs +++ b/ghcide/src/Development/IDE/GHC/Orphans.hs @@ -195,7 +195,13 @@ instance (NFData HsModule) where rnf = rwhnf instance Show OccName where show = unpack . printOutputable + + +#if MIN_VERSION_ghc(9,7,0) +instance Hashable OccName where hashWithSalt s n = hashWithSalt s (getKey $ getUnique $ occNameFS n, getKey $ getUnique $ occNameSpace n) +#else instance Hashable OccName where hashWithSalt s n = hashWithSalt s (getKey $ getUnique n) +#endif instance Show HomeModInfo where show = show . mi_module . hm_iface diff --git a/ghcide/src/Development/IDE/Plugin/Completions/Logic.hs b/ghcide/src/Development/IDE/Plugin/Completions/Logic.hs index 1ae75f1042..e8886c0c89 100644 --- a/ghcide/src/Development/IDE/Plugin/Completions/Logic.hs +++ b/ghcide/src/Development/IDE/Plugin/Completions/Logic.hs @@ -370,7 +370,11 @@ cacheDataProducer uri visibleMods curMod globalEnv inScopeEnv limports = fieldMap = Map.fromListWith (++) $ flip mapMaybe rdrElts $ \elt -> do #if MIN_VERSION_ghc(9,2,0) par <- greParent_maybe elt +#if MIN_VERSION_ghc(9,7,0) + flbl <- greFieldLabel_maybe elt +#else flbl <- greFieldLabel elt +#endif Just (par,[flLabel flbl]) #else case gre_par elt of @@ -402,7 +406,11 @@ cacheDataProducer uri visibleMods curMod globalEnv inScopeEnv limports = | is_qual spec = Map.singleton asMod compItem | otherwise = Map.fromList [(asMod,compItem),(origMod,compItem)] asMod = showModName (is_as spec) +#if MIN_VERSION_ghc(9,8,0) + origMod = showModName (moduleName $ is_mod spec) +#else origMod = showModName (is_mod spec) +#endif in (unqual,QualCompls qual) toCompItem :: Parent -> Module -> T.Text -> Name -> Maybe (LImportDecl GhcPs) -> [CompItem] diff --git a/ghcide/src/Development/IDE/Plugin/TypeLenses.hs b/ghcide/src/Development/IDE/Plugin/TypeLenses.hs index 338cd118d3..347f7622a3 100644 --- a/ghcide/src/Development/IDE/Plugin/TypeLenses.hs +++ b/ghcide/src/Development/IDE/Plugin/TypeLenses.hs @@ -313,7 +313,7 @@ gblBindingType (Just hsc) (Just gblEnv) = do showDoc = showDocRdrEnv hsc rdrEnv hasSig :: (Monad m) => Name -> m a -> m (Maybe a) hasSig name f = whenMaybe (name `elemNameSet` sigs) f - bindToSig identifier = do + bindToSig identifier = liftZonkM $ do let name = idName identifier hasSig name $ do env <- tcInitTidyEnv diff --git a/ghcide/src/Development/IDE/Types/Exports.hs b/ghcide/src/Development/IDE/Types/Exports.hs index 60ac50e7b4..d2a1739f4a 100644 --- a/ghcide/src/Development/IDE/Types/Exports.hs +++ b/ghcide/src/Development/IDE/Types/Exports.hs @@ -43,7 +43,7 @@ data ExportsMap = ExportsMap } instance NFData ExportsMap where - rnf (ExportsMap a b) = foldOccEnv (\c d -> rnf c `seq` d) (seqEltsUFM rnf b) a + rnf (ExportsMap a b) = nonDetFoldOccEnv (\c d -> rnf c `seq` d) (seqEltsUFM rnf b) a instance Show ExportsMap where show (ExportsMap occs mods) = @@ -80,7 +80,7 @@ mkTypeOcc :: Text -> OccName mkTypeOcc t = mkTcOccFS $ mkFastStringByteString $ encodeUtf8 t exportsMapSize :: ExportsMap -> Int -exportsMapSize = foldOccEnv (\_ x -> x+1) 0 . getExportsMap +exportsMapSize = nonDetFoldOccEnv (\_ x -> x+1) 0 . getExportsMap instance Semigroup ExportsMap where ExportsMap a b <> ExportsMap c d = ExportsMap (plusOccEnv_C (<>) a c) (plusUFM_C (<>) b d) diff --git a/ghcide/test/exe/CompletionTests.hs b/ghcide/test/exe/CompletionTests.hs index 00ebc4724e..4508197bcc 100644 --- a/ghcide/test/exe/CompletionTests.hs +++ b/ghcide/test/exe/CompletionTests.hs @@ -261,7 +261,7 @@ nonLocalCompletionTests = [] ] where - brokenForWinGhc = knownBrokenFor (BrokenSpecific Windows [GHC90, GHC92, GHC94, GHC96]) "Windows has strange things in scope for some reason" + brokenForWinGhc = knownBrokenFor (BrokenSpecific Windows [GHC90, GHC92, GHC94, GHC96, GHC98]) "Windows has strange things in scope for some reason" otherCompletionTests :: [TestTree] otherCompletionTests = [ @@ -302,7 +302,7 @@ otherCompletionTests = [ _ <- waitForDiagnostics compls <- getCompletions docA $ Position 2 4 let compls' = [txt | CompletionItem {_insertText = Just txt, ..} <- compls, _label == "member"] - liftIO $ take 2 compls' @?= ["member"], + liftIO $ take 1 compls' @?= ["member"], testSessionWait "maxCompletions" $ do doc <- createDoc "A.hs" "haskell" $ T.unlines diff --git a/ghcide/test/exe/HighlightTests.hs b/ghcide/test/exe/HighlightTests.hs index 34b5662810..e01377615d 100644 --- a/ghcide/test/exe/HighlightTests.hs +++ b/ghcide/test/exe/HighlightTests.hs @@ -44,7 +44,7 @@ tests = testGroup "highlight" , DocumentHighlight (R 6 10 6 13) (Just DocumentHighlightKind_Read) , DocumentHighlight (R 7 12 7 15) (Just DocumentHighlightKind_Read) ] - , knownBrokenForGhcVersions [GHC90, GHC92, GHC94, GHC96] "Ghc9 highlights the constructor and not just this field" $ + , knownBrokenForGhcVersions [GHC90, GHC92, GHC94, GHC96, GHC98] "Ghc9 highlights the constructor and not just this field" $ testSessionWait "record" $ do doc <- createDoc "A.hs" "haskell" recsource _ <- waitForDiagnostics diff --git a/ghcide/test/exe/PluginSimpleTests.hs b/ghcide/test/exe/PluginSimpleTests.hs index aedc111ff4..cc5b5eba6c 100644 --- a/ghcide/test/exe/PluginSimpleTests.hs +++ b/ghcide/test/exe/PluginSimpleTests.hs @@ -36,7 +36,7 @@ tests = -- Error: cabal: Failed to build ghc-typelits-natnormalise-0.7.7 (which is -- required by plugin-1.0.0). See the build log above for details. - ignoreFor (BrokenForGHC [GHC96]) "fragile, frequently times out" $ + ignoreFor (BrokenForGHC [GHC96, GHC98]) "fragile, frequently times out" $ ignoreFor (BrokenSpecific Windows [GHC94]) "ghc-typelist-natnormalise fails to build on GHC 9.4.2 for windows only" $ testSessionWithExtraFiles "plugin-knownnat" "simple plugin" $ \dir -> do _ <- openDoc (dir "KnownNat.hs") "haskell" diff --git a/ghcide/test/exe/TestUtils.hs b/ghcide/test/exe/TestUtils.hs index bb90f93505..7ecd765e10 100644 --- a/ghcide/test/exe/TestUtils.hs +++ b/ghcide/test/exe/TestUtils.hs @@ -167,7 +167,7 @@ ignoreInWindowsBecause :: String -> TestTree -> TestTree ignoreInWindowsBecause = ignoreFor (BrokenForOS Windows) ignoreForGHC92Plus :: String -> TestTree -> TestTree -ignoreForGHC92Plus = ignoreFor (BrokenForGHC [GHC92, GHC94, GHC96]) +ignoreForGHC92Plus = ignoreFor (BrokenForGHC [GHC92, GHC94, GHC96, GHC98]) knownBrokenForGhcVersions :: [GhcVersion] -> String -> TestTree -> TestTree knownBrokenForGhcVersions ghcVers = knownBrokenFor (BrokenForGHC ghcVers) diff --git a/haskell-language-server.cabal b/haskell-language-server.cabal index 76f3da9bbe..717a911fbf 100644 --- a/haskell-language-server.cabal +++ b/haskell-language-server.cabal @@ -207,7 +207,7 @@ common cabal cpp-options: -Dhls_cabal common class - if flag(class) + if flag(class) && (impl(ghc < 9.8.0) || flag(ignore-plugins-ghc-bounds)) build-depends: hls-class-plugin == 2.3.0.0 cpp-options: -Dhls_class @@ -227,17 +227,17 @@ common importLens cpp-options: -Dhls_importLens common rename - if flag(rename) + if flag(rename) && (impl(ghc < 9.8.0) || flag(ignore-plugins-ghc-bounds)) build-depends: hls-rename-plugin == 2.3.0.0 cpp-options: -Dhls_rename common retrie - if flag(retrie) + if flag(retrie) && (impl(ghc < 9.8.0) || flag(ignore-plugins-ghc-bounds)) build-depends: hls-retrie-plugin == 2.3.0.0 cpp-options: -Dhls_retrie common hlint - if flag(hlint) + if flag(hlint) && (impl(ghc < 9.8.0) || flag(ignore-plugins-ghc-bounds)) build-depends: hls-hlint-plugin == 2.3.0.0 cpp-options: -Dhls_hlint @@ -252,7 +252,7 @@ common pragmas cpp-options: -Dhls_pragmas common splice - if flag(splice) + if flag(splice) && (impl(ghc < 9.8.0) || flag(ignore-plugins-ghc-bounds)) build-depends: hls-splice-plugin == 2.3.0.0 cpp-options: -Dhls_splice @@ -277,7 +277,7 @@ common changeTypeSignature cpp-options: -Dhls_changeTypeSignature common gadt - if flag(gadt) + if flag(gadt) && (impl(ghc < 9.8.0) || flag(ignore-plugins-ghc-bounds)) build-depends: hls-gadt-plugin == 2.3.0.0 cpp-options: -Dhls_gadt @@ -304,7 +304,7 @@ common floskell cpp-options: -Dhls_floskell common fourmolu - if flag(fourmolu) + if flag(fourmolu) && (impl(ghc < 9.8.0) || flag(ignore-plugins-ghc-bounds)) build-depends: hls-fourmolu-plugin == 2.3.0.0 cpp-options: -Dhls_fourmolu @@ -314,12 +314,12 @@ common ormolu cpp-options: -Dhls_ormolu common stylishHaskell - if flag(stylishHaskell) + if flag(stylishHaskell) && (impl(ghc < 9.8.0) || flag(ignore-plugins-ghc-bounds)) build-depends: hls-stylish-haskell-plugin == 2.3.0.0 cpp-options: -Dhls_stylishHaskell common refactor - if flag(refactor) + if flag(refactor) && (impl(ghc < 9.8.0) || flag(ignore-plugins-ghc-bounds)) build-depends: hls-refactor-plugin == 2.3.0.0 cpp-options: -Dhls_refactor diff --git a/hie-compat/hie-compat.cabal b/hie-compat/hie-compat.cabal index 8f3c69216e..788e2dccb7 100644 --- a/hie-compat/hie-compat.cabal +++ b/hie-compat/hie-compat.cabal @@ -39,5 +39,5 @@ library hs-source-dirs: src-ghc90 src-reexport-ghc9 if (impl(ghc >= 9.2) && impl(ghc < 9.3)) hs-source-dirs: src-ghc92 src-reexport-ghc9 - if (impl(ghc >= 9.4) && impl(ghc < 9.7)) + if (impl(ghc >= 9.4)) hs-source-dirs: src-reexport-ghc92 diff --git a/hls-test-utils/src/Test/Hls.hs b/hls-test-utils/src/Test/Hls.hs index 0bbdbc0b72..a52e46f950 100644 --- a/hls-test-utils/src/Test/Hls.hs +++ b/hls-test-utils/src/Test/Hls.hs @@ -1,5 +1,6 @@ {-# LANGUAGE DataKinds #-} {-# LANGUAGE DisambiguateRecordFields #-} +{-# LANGUAGE DuplicateRecordFields #-} {-# LANGUAGE GADTs #-} {-# LANGUAGE LambdaCase #-} {-# LANGUAGE NamedFieldPuns #-} diff --git a/plugins/hls-alternate-number-format-plugin/hls-alternate-number-format-plugin.cabal b/plugins/hls-alternate-number-format-plugin/hls-alternate-number-format-plugin.cabal index 91f12a4d50..fd3cb134f4 100644 --- a/plugins/hls-alternate-number-format-plugin/hls-alternate-number-format-plugin.cabal +++ b/plugins/hls-alternate-number-format-plugin/hls-alternate-number-format-plugin.cabal @@ -22,7 +22,6 @@ source-repository head location: https://github.com/haskell/haskell-language-server.git library - buildable: True exposed-modules: Ide.Plugin.AlternateNumberFormat, Ide.Plugin.Conversion other-modules: Ide.Plugin.Literals hs-source-dirs: src @@ -53,7 +52,6 @@ library RecordWildCards test-suite tests - buildable: True type: exitcode-stdio-1.0 default-language: Haskell2010 hs-source-dirs: test diff --git a/plugins/hls-alternate-number-format-plugin/src/Ide/Plugin/Literals.hs b/plugins/hls-alternate-number-format-plugin/src/Ide/Plugin/Literals.hs index 1c23bee738..21b9cd4699 100644 --- a/plugins/hls-alternate-number-format-plugin/src/Ide/Plugin/Literals.hs +++ b/plugins/hls-alternate-number-format-plugin/src/Ide/Plugin/Literals.hs @@ -14,6 +14,9 @@ module Ide.Plugin.Literals ( import Data.Maybe (maybeToList) import Data.Text (Text) import qualified Data.Text as T +#if __GLASGOW_HASKELL__ >= 908 +import qualified Data.Text.Encoding as T +#endif import Development.IDE.GHC.Compat hiding (getSrcSpan) import Development.IDE.Graph.Classes (NFData (rnf)) import Generics.SYB (Data, Typeable, everything, @@ -100,5 +103,9 @@ fromFractionalLit s fl@FL{fl_text} = fmap (\txt' -> FracLiteral (LiteralSrcSpan fromSourceText :: SourceText -> Maybe Text fromSourceText = \case +#if __GLASGOW_HASKELL__ >= 908 + SourceText s -> Just $ T.decodeUtf8 $ bytesFS s +#else SourceText s -> Just $ T.pack s +#endif NoSourceText -> Nothing diff --git a/plugins/hls-call-hierarchy-plugin/hls-call-hierarchy-plugin.cabal b/plugins/hls-call-hierarchy-plugin/hls-call-hierarchy-plugin.cabal index 2bbf3aa69b..a0a04df91f 100644 --- a/plugins/hls-call-hierarchy-plugin/hls-call-hierarchy-plugin.cabal +++ b/plugins/hls-call-hierarchy-plugin/hls-call-hierarchy-plugin.cabal @@ -46,7 +46,6 @@ library default-extensions: DataKinds test-suite tests - buildable: True type: exitcode-stdio-1.0 default-language: Haskell2010 hs-source-dirs: test diff --git a/plugins/hls-change-type-signature-plugin/hls-change-type-signature-plugin.cabal b/plugins/hls-change-type-signature-plugin/hls-change-type-signature-plugin.cabal index a5f836d579..51f5dfcce7 100644 --- a/plugins/hls-change-type-signature-plugin/hls-change-type-signature-plugin.cabal +++ b/plugins/hls-change-type-signature-plugin/hls-change-type-signature-plugin.cabal @@ -23,7 +23,6 @@ source-repository head location: https://github.com/haskell/haskell-language-server.git library - buildable: True exposed-modules: Ide.Plugin.ChangeTypeSignature hs-source-dirs: src build-depends: @@ -51,7 +50,6 @@ library test-suite tests - buildable: True type: exitcode-stdio-1.0 default-language: Haskell2010 hs-source-dirs: test diff --git a/plugins/hls-change-type-signature-plugin/test/Main.hs b/plugins/hls-change-type-signature-plugin/test/Main.hs index 53f51a97e7..98f45f3929 100644 --- a/plugins/hls-change-type-signature-plugin/test/Main.hs +++ b/plugins/hls-change-type-signature-plugin/test/Main.hs @@ -40,7 +40,7 @@ test :: TestTree test = testGroup "changeTypeSignature" [ testRegexes , codeActionTest "TExpectedActual" 4 11 - , knownBrokenForGhcVersions [GHC92, GHC94, GHC96] "Error Message in 9.2/9.4 does not provide enough info" $ codeActionTest "TRigidType" 4 14 + , knownBrokenForGhcVersions [GHC92, GHC94, GHC96, GHC98] "Error Message in 9.2/9.4 does not provide enough info" $ codeActionTest "TRigidType" 4 14 , codeActionTest "TRigidType2" 4 6 , codeActionTest "TLocalBinding" 7 22 , codeActionTest "TLocalBindingShadow1" 11 8 diff --git a/plugins/hls-class-plugin/hls-class-plugin.cabal b/plugins/hls-class-plugin/hls-class-plugin.cabal index 2f251f7823..d1903276c2 100644 --- a/plugins/hls-class-plugin/hls-class-plugin.cabal +++ b/plugins/hls-class-plugin/hls-class-plugin.cabal @@ -25,6 +25,11 @@ 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.Class other-modules: Ide.Plugin.Class.CodeAction , Ide.Plugin.Class.CodeLens @@ -63,6 +68,10 @@ library ghc-options: -Wall -Wno-unticked-promoted-constructors -Wno-name-shadowing 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-eval-plugin/src/Ide/Plugin/Eval/CodeLens.hs b/plugins/hls-eval-plugin/src/Ide/Plugin/Eval/CodeLens.hs index 7eca4f0321..2a65f10ec8 100644 --- a/plugins/hls-eval-plugin/src/Ide/Plugin/Eval/CodeLens.hs +++ b/plugins/hls-eval-plugin/src/Ide/Plugin/Eval/CodeLens.hs @@ -59,7 +59,8 @@ import Development.IDE.Core.Shake (useNoFile_, import Development.IDE.GHC.Compat hiding (typeKind, unitState) import Development.IDE.GHC.Compat.Util (GhcException, - OverridingBool (..)) + OverridingBool (..), + bagToList) import Development.IDE.GHC.Util (evalGhcEnv, modifyDynFlags, printOutputable) @@ -266,7 +267,12 @@ initialiseSessionForEval needs_quickcheck st nfp = do addRdrEnv hmi | iface <- hm_iface hmi , ms_mod ms == mi_module iface - = hmi { hm_iface = iface { mi_globals = Just rdr_env } } + = hmi { hm_iface = iface { mi_globals = Just $! +#if MIN_VERSION_ghc(9,8,0) + forceGlobalRdrEnv +#endif + rdr_env + }} | otherwise = hmi return (ms, linkable_hsc) @@ -446,15 +452,14 @@ evals mark_exception (st, fp) df stmts = do parseDynamicFlagsCmdLine ndf (map (L $ UnhelpfulSpan unhelpfulReason) flags) dbg "parsed flags" $ eans - <&> (_1 %~ showDynFlags >>> _3 %~ map warnMsg) + <&> (_1 %~ showDynFlags >>> _3 %~ prettyWarnings) case eans of Left err -> pure $ Just $ errorLines $ show err Right (df', ignoreds, warns) -> do let warnings = do guard $ not $ null warns pure $ errorLines $ - unlines $ - map prettyWarn warns + prettyWarnings warns igns = do guard $ not $ null ignoreds pure @@ -497,10 +502,18 @@ evals mark_exception (st, fp) df stmts = do let opts = execOptions{execSourceFile = fp, execLineNumber = l} in myExecStmt stmt opts +#if MIN_VERSION_ghc(9,8,0) +prettyWarnings :: Messages DriverMessage -> String +prettyWarnings = printWithoutUniques . pprMessages (defaultDiagnosticOpts @DriverMessage) +#else +prettyWarnings :: [Warn] -> String +prettyWarnings = unlines . map prettyWarn + prettyWarn :: Warn -> String prettyWarn Warn{..} = T.unpack (printOutputable $ SrcLoc.getLoc warnMsg) <> ": warning:\n" <> " " <> SrcLoc.unLoc warnMsg +#endif needsQuickCheck :: [(Section, Test)] -> Bool needsQuickCheck = any (isProperty . snd) diff --git a/plugins/hls-eval-plugin/src/Ide/Plugin/Eval/Util.hs b/plugins/hls-eval-plugin/src/Ide/Plugin/Eval/Util.hs index 2c1d012291..86adf2cb56 100644 --- a/plugins/hls-eval-plugin/src/Ide/Plugin/Eval/Util.hs +++ b/plugins/hls-eval-plugin/src/Ide/Plugin/Eval/Util.hs @@ -59,7 +59,9 @@ logWith state key val = logWithPos = let stk = toList callStack pr pos = concat [srcLocFile pos, ":", show . srcLocStartLine $ pos, ":", show . srcLocStartCol $ pos] - in if null stk then "" else pr . snd . head $ stk + in case stk of + [] -> "" + (x:_) -> pr $ snd x asT :: Show a => a -> T.Text asT = T.pack . show diff --git a/plugins/hls-eval-plugin/test/Main.hs b/plugins/hls-eval-plugin/test/Main.hs index 998ee81a88..18f718633b 100644 --- a/plugins/hls-eval-plugin/test/Main.hs +++ b/plugins/hls-eval-plugin/test/Main.hs @@ -93,8 +93,8 @@ tests = ) , goldenWithEval' "Shows a kind with :kind" "T12" "hs" (if ghcVersion >= GHC92 then "ghc92.expected" else "expected") , goldenWithEval' "Reports an error for an incorrect type with :kind" "T13" "hs" (if ghcVersion >= GHC92 then "ghc92.expected" else "expected") - , goldenWithEval "Returns a fully-instantiated type for :type" "T14" "hs" - , knownBrokenForGhcVersions [GHC92, GHC94, GHC96] "type +v does not work anymore with 9.2" $ goldenWithEval "Returns an uninstantiated type for :type +v, admitting multiple whitespaces around arguments" "T15" "hs" + , goldenWithEval' "Returns a fully-instantiated type for :type" "T14" "hs" (if ghcVersion >= GHC98 then "ghc98.expected" else "expected") -- See https://gitlab.haskell.org/ghc/ghc/-/issues/24069 + , knownBrokenForGhcVersions [GHC92, GHC94, GHC96, GHC98] "type +v does not work anymore with 9.2" $ goldenWithEval "Returns an uninstantiated type for :type +v, admitting multiple whitespaces around arguments" "T15" "hs" , goldenWithEval "Returns defaulted type for :type +d, admitting multiple whitespaces around arguments" "T16" "hs" , goldenWithEval' ":type reports an error when given with unknown +x option" "T17" "hs" (if ghcVersion >= GHC92 then "ghc92.expected" else "expected") , goldenWithEval "Reports an error when given with unknown command" "T18" "hs" @@ -134,7 +134,7 @@ tests = , goldenWithEvalAndFs "Transitive local dependency" (FS.directProjectMulti ["TTransitive.hs", "TLocalImport.hs", "Util.hs"]) "TTransitive" "hs" -- , goldenWithEval "Local Modules can be imported in a test" "TLocalImportInTest" "hs" , goldenWithEval "Setting language option TupleSections" "TLanguageOptionsTupleSections" "hs" - , goldenWithEval' ":set accepts ghci flags" "TFlags" "hs" (if ghcVersion >= GHC92 then "ghc92.expected" else "expected") + , goldenWithEval' ":set accepts ghci flags" "TFlags" "hs" (if ghcVersion >= GHC92 then "ghc98.expected" else if ghcVersion >= GHC92 then "ghc92.expected" else "expected") , testCase ":set -fprint-explicit-foralls works" $ do evalInFile "T8.hs" "-- >>> :t id" "-- id :: a -> a" evalInFile "T8.hs" "-- >>> :set -fprint-explicit-foralls\n-- >>> :t id" diff --git a/plugins/hls-explicit-fixity-plugin/hls-explicit-fixity-plugin.cabal b/plugins/hls-explicit-fixity-plugin/hls-explicit-fixity-plugin.cabal index 58bdfff4ab..10e95593ab 100644 --- a/plugins/hls-explicit-fixity-plugin/hls-explicit-fixity-plugin.cabal +++ b/plugins/hls-explicit-fixity-plugin/hls-explicit-fixity-plugin.cabal @@ -20,7 +20,6 @@ source-repository head location: https://github.com/haskell/haskell-language-server.git library - buildable: True exposed-modules: Ide.Plugin.ExplicitFixity hs-source-dirs: src @@ -45,7 +44,6 @@ library default-extensions: DataKinds test-suite tests - buildable: True type: exitcode-stdio-1.0 default-language: Haskell2010 hs-source-dirs: test diff --git a/plugins/hls-explicit-fixity-plugin/test/Main.hs b/plugins/hls-explicit-fixity-plugin/test/Main.hs index 61235c5fbe..13dca58f8d 100644 --- a/plugins/hls-explicit-fixity-plugin/test/Main.hs +++ b/plugins/hls-explicit-fixity-plugin/test/Main.hs @@ -34,7 +34,8 @@ tests = testGroup "Explicit fixity" , hoverTest "(<|>)" (Position 21 8) "infixl 3 `<|>`" , hoverTest "fixity define" (Position 23 11) "infixr 7 `>>:`" , hoverTest "record" (Position 28 10) "infix 9 `>>::`" - , hoverTest "wildcards" (Position 30 5) "infixr 7 `>>:` \n \ninfix 9 `>>::`" + , hoverTest "wildcards1" (Position 30 5) "infixr 7 `>>:`" + , hoverTest "wildcards2" (Position 30 5) "infix 9 `>>::`" , hoverTest "function" (Position 32 11) "infixl 1 `f`" , hoverTest "signature" (Position 35 2) "infixr 9 `>>>:`" , hoverTest "operator" (Position 36 2) "infixr 9 `>>>:`" diff --git a/plugins/hls-explicit-imports-plugin/hls-explicit-imports-plugin.cabal b/plugins/hls-explicit-imports-plugin/hls-explicit-imports-plugin.cabal index 0b306a51d1..1503235d16 100644 --- a/plugins/hls-explicit-imports-plugin/hls-explicit-imports-plugin.cabal +++ b/plugins/hls-explicit-imports-plugin/hls-explicit-imports-plugin.cabal @@ -29,7 +29,6 @@ common warnings library import: warnings - buildable: True exposed-modules: Ide.Plugin.ExplicitImports hs-source-dirs: src build-depends: @@ -58,7 +57,6 @@ library test-suite tests import: warnings - buildable: True type: exitcode-stdio-1.0 default-language: Haskell2010 hs-source-dirs: test @@ -73,4 +71,4 @@ test-suite tests , lens , lsp-types , row-types - , text \ No newline at end of file + , text diff --git a/plugins/hls-explicit-imports-plugin/src/Ide/Plugin/ExplicitImports.hs b/plugins/hls-explicit-imports-plugin/src/Ide/Plugin/ExplicitImports.hs index 98bae2028b..a18d204759 100644 --- a/plugins/hls-explicit-imports-plugin/src/Ide/Plugin/ExplicitImports.hs +++ b/plugins/hls-explicit-imports-plugin/src/Ide/Plugin/ExplicitImports.hs @@ -466,9 +466,11 @@ filterByImport (ImportDecl{ideclHiding = Just (_, L _ names)}) where importedNames = S.fromList $ map (ieName . unLoc) names res = flip Map.filter avails $ \a -> any (`S.member` importedNames) - $ concatMap availNamesWithSelectors a + $ concatMap + getAvailNames + a allFilteredAvailsNames = S.fromList - $ concatMap availNamesWithSelectors + $ concatMap getAvailNames $ mconcat $ Map.elems res filterByImport _ _ = Nothing @@ -496,6 +498,14 @@ constructImport ImportDecl{ideclQualified = qualified, ideclHiding = origHiding} containsAvail :: LIE GhcRn -> AvailInfo -> Bool containsAvail name avail = any (\an -> printOutputable an == (printOutputable . ieName . unLoc $ name)) - $ availNamesWithSelectors avail + $ getAvailNames avail constructImport _ lim _ = lim + +getAvailNames :: AvailInfo -> [Name] +getAvailNames = +#if MIN_VERSION_ghc(9,7,0) + availNames +#else + availNamesWithSelectors +#endif diff --git a/plugins/hls-floskell-plugin/hls-floskell-plugin.cabal b/plugins/hls-floskell-plugin/hls-floskell-plugin.cabal index eab1db669a..de34f436ba 100644 --- a/plugins/hls-floskell-plugin/hls-floskell-plugin.cabal +++ b/plugins/hls-floskell-plugin/hls-floskell-plugin.cabal @@ -21,6 +21,7 @@ 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.5) buildable: False exposed-modules: Ide.Plugin.Floskell diff --git a/plugins/hls-fourmolu-plugin/hls-fourmolu-plugin.cabal b/plugins/hls-fourmolu-plugin/hls-fourmolu-plugin.cabal index 8556d88c04..424a6180e8 100644 --- a/plugins/hls-fourmolu-plugin/hls-fourmolu-plugin.cabal +++ b/plugins/hls-fourmolu-plugin/hls-fourmolu-plugin.cabal @@ -23,7 +23,11 @@ source-repository head location: git://github.com/haskell/haskell-language-server.git library - buildable: True + -- 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.Fourmolu hs-source-dirs: src @@ -55,7 +59,10 @@ library default-language: Haskell2010 test-suite tests - buildable: True + 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/hls-gadt-plugin.cabal b/plugins/hls-gadt-plugin/hls-gadt-plugin.cabal index 26d59b2795..bd6e17d01f 100644 --- a/plugins/hls-gadt-plugin/hls-gadt-plugin.cabal +++ b/plugins/hls-gadt-plugin/hls-gadt-plugin.cabal @@ -20,6 +20,11 @@ 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 @@ -50,6 +55,10 @@ 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-hlint-plugin/hls-hlint-plugin.cabal b/plugins/hls-hlint-plugin/hls-hlint-plugin.cabal index 2cbca832f0..f4f3749c21 100644 --- a/plugins/hls-hlint-plugin/hls-hlint-plugin.cabal +++ b/plugins/hls-hlint-plugin/hls-hlint-plugin.cabal @@ -30,6 +30,11 @@ flag pedantic manual: True 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.Hlint hs-source-dirs: src build-depends: @@ -77,6 +82,10 @@ 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/plugins/hls-module-name-plugin/hls-module-name-plugin.cabal b/plugins/hls-module-name-plugin/hls-module-name-plugin.cabal index a7ce0599a1..2c50cfe5da 100644 --- a/plugins/hls-module-name-plugin/hls-module-name-plugin.cabal +++ b/plugins/hls-module-name-plugin/hls-module-name-plugin.cabal @@ -24,7 +24,6 @@ source-repository head location: https://github.com/haskell/haskell-language-server.git library - buildable: True exposed-modules: Ide.Plugin.ModuleName hs-source-dirs: src build-depends: @@ -43,7 +42,6 @@ library default-language: Haskell2010 test-suite tests - buildable: True type: exitcode-stdio-1.0 default-language: Haskell2010 hs-source-dirs: test diff --git a/plugins/hls-ormolu-plugin/hls-ormolu-plugin.cabal b/plugins/hls-ormolu-plugin/hls-ormolu-plugin.cabal index cc2606e24b..422befbb2e 100644 --- a/plugins/hls-ormolu-plugin/hls-ormolu-plugin.cabal +++ b/plugins/hls-ormolu-plugin/hls-ormolu-plugin.cabal @@ -23,6 +23,7 @@ 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.7) buildable: False exposed-modules: Ide.Plugin.Ormolu diff --git a/plugins/hls-overloaded-record-dot-plugin/hls-overloaded-record-dot-plugin.cabal b/plugins/hls-overloaded-record-dot-plugin/hls-overloaded-record-dot-plugin.cabal index 0c41c8553d..de2f6899f7 100644 --- a/plugins/hls-overloaded-record-dot-plugin/hls-overloaded-record-dot-plugin.cabal +++ b/plugins/hls-overloaded-record-dot-plugin/hls-overloaded-record-dot-plugin.cabal @@ -22,11 +22,11 @@ common warnings ghc-options: -Wall library - import: warnings if impl(ghc < 9.2) buildable: False else buildable: True + import: warnings exposed-modules: Ide.Plugin.OverloadedRecordDot build-depends: , base >=4.16 && <5 diff --git a/plugins/hls-pragmas-plugin/hls-pragmas-plugin.cabal b/plugins/hls-pragmas-plugin/hls-pragmas-plugin.cabal index 7f26132f25..465fa52bfd 100644 --- a/plugins/hls-pragmas-plugin/hls-pragmas-plugin.cabal +++ b/plugins/hls-pragmas-plugin/hls-pragmas-plugin.cabal @@ -22,7 +22,6 @@ source-repository head location: https://github.com/haskell/haskell-language-server.git library - buildable: True exposed-modules: Ide.Plugin.Pragmas hs-source-dirs: src build-depends: @@ -42,7 +41,6 @@ library default-language: Haskell2010 test-suite tests - buildable: True type: exitcode-stdio-1.0 default-language: Haskell2010 hs-source-dirs: test diff --git a/plugins/hls-refactor-plugin/hls-refactor-plugin.cabal b/plugins/hls-refactor-plugin/hls-refactor-plugin.cabal index 702a8fc16a..2faf102828 100644 --- a/plugins/hls-refactor-plugin/hls-refactor-plugin.cabal +++ b/plugins/hls-refactor-plugin/hls-refactor-plugin.cabal @@ -22,6 +22,11 @@ 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: Development.IDE.GHC.ExactPrint Development.IDE.GHC.Compat.ExactPrint Development.IDE.Plugin.CodeAction @@ -93,6 +98,10 @@ 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-rename-plugin/hls-rename-plugin.cabal b/plugins/hls-rename-plugin/hls-rename-plugin.cabal index c1fda74f88..7c0b3f52ce 100644 --- a/plugins/hls-rename-plugin/hls-rename-plugin.cabal +++ b/plugins/hls-rename-plugin/hls-rename-plugin.cabal @@ -21,6 +21,11 @@ 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: @@ -48,6 +53,10 @@ 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 49568a7dfb..d4ae524f38 100644 --- a/plugins/hls-retrie-plugin/hls-retrie-plugin.cabal +++ b/plugins/hls-retrie-plugin/hls-retrie-plugin.cabal @@ -21,6 +21,11 @@ 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: @@ -55,7 +60,10 @@ library ghc-options: -Wno-unticked-promoted-constructors test-suite tests - buildable: True + 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 1b4444e092..383cc0c86e 100644 --- a/plugins/hls-splice-plugin/hls-splice-plugin.cabal +++ b/plugins/hls-splice-plugin/hls-splice-plugin.cabal @@ -27,6 +27,11 @@ 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 @@ -61,6 +66,10 @@ 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/plugins/hls-stylish-haskell-plugin/hls-stylish-haskell-plugin.cabal b/plugins/hls-stylish-haskell-plugin/hls-stylish-haskell-plugin.cabal index 518d23f165..776bd4bb6c 100644 --- a/plugins/hls-stylish-haskell-plugin/hls-stylish-haskell-plugin.cabal +++ b/plugins/hls-stylish-haskell-plugin/hls-stylish-haskell-plugin.cabal @@ -20,6 +20,11 @@ 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.StylishHaskell hs-source-dirs: src build-depends: @@ -38,6 +43,10 @@ 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