diff --git a/.github/workflows/supported-ghc-versions.json b/.github/workflows/supported-ghc-versions.json index b530e284e0..e46e627b7c 100644 --- a/.github/workflows/supported-ghc-versions.json +++ b/.github/workflows/supported-ghc-versions.json @@ -1 +1 @@ -["9.10", "9.8", "9.6", "9.4"] +["9.12", "9.10", "9.8", "9.6", "9.4"] diff --git a/.github/workflows/test.yml b/.github/workflows/test.yml index 544a9c6e78..eb28c95a51 100644 --- a/.github/workflows/test.yml +++ b/.github/workflows/test.yml @@ -134,12 +134,12 @@ jobs: HLS_WRAPPER_TEST_EXE: hls-wrapper run: cabal test wrapper-test - - if: matrix.test + - if: matrix.test && matrix.ghc != '9.12' name: Test hls-refactor-plugin run: cabal test hls-refactor-plugin-tests || cabal test hls-refactor-plugin-tests # TODO enable when it supports 9.10 - - if: matrix.test && matrix.ghc != '9.10' + - if: matrix.test && matrix.ghc != '9.10' && matrix.ghc != '9.12' name: Test hls-floskell-plugin run: cabal test hls-floskell-plugin-tests || cabal test hls-floskell-plugin-tests @@ -156,24 +156,24 @@ jobs: run: cabal test hls-eval-plugin-tests || cabal test hls-eval-plugin-tests # TODO enable when it supports 9.10 - - if: matrix.test && matrix.ghc != '9.10' + - if: matrix.test && matrix.ghc != '9.10' && matrix.ghc != '9.12' name: Test hls-splice-plugin run: cabal test hls-splice-plugin-tests || cabal test hls-splice-plugin-tests - - if: matrix.test + - if: matrix.test && matrix.ghc != '9.12' name: Test hls-stan-plugin run: cabal test hls-stan-plugin-tests || cabal test hls-stan-plugin-tests # TODO enable when it supports 9.10 - - if: matrix.test && matrix.ghc != '9.10' + - if: matrix.test && matrix.ghc != '9.10' && matrix.ghc != '9.12' name: Test hls-stylish-haskell-plugin run: cabal test hls-stylish-haskell-plugin-tests || cabal test hls-stylish-haskell-plugin-tests - - if: matrix.test + - if: matrix.test && matrix.ghc != '9.12' name: Test hls-ormolu-plugin run: cabal test hls-ormolu-plugin-tests || cabal test hls-ormolu-plugin-tests - - if: matrix.test + - if: matrix.test && matrix.ghc != '9.12' name: Test hls-fourmolu-plugin run: cabal test hls-fourmolu-plugin-tests || cabal test hls-fourmolu-plugin-tests @@ -185,12 +185,12 @@ jobs: name: Test hls-call-hierarchy-plugin test suite run: cabal test hls-call-hierarchy-plugin-tests || cabal test hls-call-hierarchy-plugin-tests - - if: matrix.test && matrix.os != 'windows-latest' + - if: matrix.test && matrix.os != 'windows-latest' && matrix.ghc != '9.12' name: Test hls-rename-plugin test suite run: cabal test hls-rename-plugin-tests || cabal test hls-rename-plugin-tests # TODO enable when it supports 9.10 - - if: matrix.test && matrix.ghc != '9.10' + - if: matrix.test && matrix.ghc != '9.10' && matrix.ghc != '9.12' name: Test hls-hlint-plugin test suite run: cabal test hls-hlint-plugin-tests || cabal test hls-hlint-plugin-tests @@ -214,7 +214,7 @@ jobs: name: Test hls-change-type-signature test suite run: cabal test hls-change-type-signature-plugin-tests || cabal test hls-change-type-signature-plugin-tests - - if: matrix.test + - if: matrix.test && matrix.ghc != '9.12' name: Test hls-gadt-plugin test suit run: cabal test hls-gadt-plugin-tests || cabal test hls-gadt-plugin-tests @@ -227,11 +227,11 @@ jobs: run: cabal test hls-explicit-record-fields-plugin-tests || cabal test hls-explicit-record-fields-plugin-tests # versions need to be limited since the tests depend on cabal-fmt which only builds with ghc <9.10 - - if: matrix.test && matrix.ghc != '9.10' + - if: matrix.test && matrix.ghc != '9.10' && matrix.ghc != '9.12' name: Test hls-cabal-fmt-plugin test suite run: cabal test hls-cabal-fmt-plugin-tests --flag=isolateCabalfmtTests || cabal test hls-cabal-fmt-plugin-tests --flag=isolateCabalfmtTests - - if: matrix.test + - if: matrix.test && matrix.ghc != '9.12' name: Test hls-cabal-gild-plugin test suite run: cabal test hls-cabal-gild-plugin-tests --flag=isolateCabalGildTests || cabal test hls-cabal-gild-plugin-tests --flag=isolateCabalGildTests @@ -240,7 +240,7 @@ jobs: run: cabal test hls-cabal-plugin-tests || cabal test hls-cabal-plugin-tests # TODO enable when it supports 9.10 - - if: matrix.test && matrix.ghc != '9.10' + - if: matrix.test && matrix.ghc != '9.10' && matrix.ghc != '9.12' name: Test hls-retrie-plugin test suite run: cabal test hls-retrie-plugin-tests || cabal test hls-retrie-plugin-tests diff --git a/cabal.project b/cabal.project index d63c47ff99..f57b4079f2 100644 --- a/cabal.project +++ b/cabal.project @@ -8,7 +8,7 @@ packages: ./hls-test-utils -index-state: 2024-12-02T00:00:00Z +index-state: 2025-03-20T00:00:00Z tests: True test-show-details: direct @@ -59,3 +59,14 @@ if impl(ghc >= 9.8.4) && impl(ghc < 9.8.5) ghc-lib-parser:filepath constraints: ghc-lib-parser==9.8.4.20241130 + +if impl(ghc >= 9.11) + benchmarks: False + allow-newer: + hiedb:base, + hiedb:ghc, + hie-bios:ghc, + ghc-trace-events:base, + tasty-hspec:base, + cabal-install-parsers:base, + cabal-install-parsers:time, diff --git a/ghcide-test/exe/ExceptionTests.hs b/ghcide-test/exe/ExceptionTests.hs index 756e7e0547..a95f91e97c 100644 --- a/ghcide-test/exe/ExceptionTests.hs +++ b/ghcide-test/exe/ExceptionTests.hs @@ -8,7 +8,7 @@ import Control.Monad.Error.Class (MonadError (throwError)) import Control.Monad.IO.Class (liftIO) import qualified Data.Aeson as A import Data.Default (Default (..)) -import Data.Text as T +import qualified Data.Text as T import Development.IDE.Core.Shake (IdeState (..)) import qualified Development.IDE.LSP.Notifications as Notifications import Development.IDE.Plugin.HLS (toResponseError) diff --git a/ghcide-test/exe/FuzzySearch.hs b/ghcide-test/exe/FuzzySearch.hs index 3bc3ecb4b1..f09bb7f863 100644 --- a/ghcide-test/exe/FuzzySearch.hs +++ b/ghcide-test/exe/FuzzySearch.hs @@ -88,7 +88,7 @@ referenceImplementation :: forall s t. (t -> s) -> -- | The original value, rendered string and score. Maybe (Fuzzy t s) -referenceImplementation pat t pre post extract = +referenceImplementation pat' t pre post extract = if null pat then Just (Fuzzy t result totalScore) else Nothing where null :: (T.TextualMonoid s) => s -> Bool @@ -119,7 +119,7 @@ referenceImplementation pat t pre post extract = ( 0, 1, -- matching at the start gives a bonus (cur = 1) mempty, - pat, + pat', True ) s diff --git a/ghcide-test/exe/UnitTests.hs b/ghcide-test/exe/UnitTests.hs index b2940ab27f..d405955197 100644 --- a/ghcide-test/exe/UnitTests.hs +++ b/ghcide-test/exe/UnitTests.hs @@ -29,6 +29,8 @@ import qualified Progress import System.IO.Extra hiding (withTempDir) import System.Mem (performGC) import Test.Hls (IdeState, def, + ignoreForGhcVersions, + GhcVersion(..), runSessionWithServerInTmpDir, waitForProgressDone) import Test.Tasty diff --git a/ghcide/ghcide.cabal b/ghcide/ghcide.cabal index f705fde5b6..5ac06e21af 100644 --- a/ghcide/ghcide.cabal +++ b/ghcide/ghcide.cabal @@ -87,6 +87,7 @@ library , mtl , opentelemetry >=0.6.1 , optparse-applicative + , os-string , parallel , prettyprinter >=1.7 , prettyprinter-ansi-terminal diff --git a/ghcide/session-loader/Development/IDE/Session.hs b/ghcide/session-loader/Development/IDE/Session.hs index a1768be564..50a30c6ad2 100644 --- a/ghcide/session-loader/Development/IDE/Session.hs +++ b/ghcide/session-loader/Development/IDE/Session.hs @@ -124,6 +124,10 @@ import GHC.Types.Error (errMsgDiagnostic, singleMessage) import GHC.Unit.State +#if MIN_VERSION_ghc(9,13,0) +import GHC.Driver.Make (checkHomeUnitsClosed) +#endif + data Log = LogSettingInitialDynFlags | LogGetInitialGhcLibDirDefaultCradleFail !CradleError !FilePath !(Maybe FilePath) !(Cradle Void) @@ -782,6 +786,11 @@ toFlagsMap TargetDetails{..} = setNameCache :: NameCache -> HscEnv -> HscEnv setNameCache nc hsc = hsc { hsc_NC = nc } +#if MIN_VERSION_ghc(9,13,0) +-- Moved back to implementation in GHC. +checkHomeUnitsClosed' :: UnitEnv -> OS.Set UnitId -> [DriverMessages] +checkHomeUnitsClosed' ue _ = checkHomeUnitsClosed ue +#elif MIN_VERSION_ghc(9,3,0) -- This function checks the important property that if both p and q are home units -- then any dependency of p, which transitively depends on q is also a home unit. -- GHC had an implementation of this function, but it was horribly inefficient @@ -838,6 +847,7 @@ checkHomeUnitsClosed' ue home_id_set Just depends -> let todo'' = (depends OS.\\ done) `OS.union` todo' in DigraphNode uid uid (OS.toList depends) : go (OS.insert uid done) todo'' +#endif -- | Create a mapping from FilePaths to HscEnvEqs -- This combines all the components we know about into diff --git a/ghcide/src/Development/IDE/Core/Compile.hs b/ghcide/src/Development/IDE/Core/Compile.hs index 47872b9255..ed5e14a70a 100644 --- a/ghcide/src/Development/IDE/Core/Compile.hs +++ b/ghcide/src/Development/IDE/Core/Compile.hs @@ -36,6 +36,7 @@ module Development.IDE.Core.Compile , sourceTypecheck , sourceParser , shareUsages + , setNonHomeFCHook ) where import Control.Concurrent.STM.Stats hiding (orElse) @@ -62,11 +63,12 @@ import qualified Data.HashMap.Strict as HashMap import Data.IntMap (IntMap) import Data.IORef import Data.List.Extra +import qualified Data.List.NonEmpty as NE import qualified Data.Map.Strict as Map import Data.Maybe import Data.Proxy (Proxy (Proxy)) import qualified Data.Text as T -import Data.Time (UTCTime (..)) +import Data.Time (UTCTime (..), getCurrentTime) import Data.Tuple.Extra (dupe) import Debug.Trace import Development.IDE.Core.FileStore (resetInterfaceStore) @@ -133,6 +135,10 @@ import Development.IDE.Core.FileStore (shareFilePath) import Development.IDE.GHC.Compat.Driver (hscTypecheckRenameWithDiagnostics) +import Development.IDE.Import.DependencyInformation +import GHC.Driver.Env ( hsc_all_home_unit_ids ) +import Development.IDE.Import.FindImports + --Simple constants to make sure the source is consistently named sourceTypecheck :: T.Text sourceTypecheck = "typecheck" @@ -168,9 +174,10 @@ computePackageDeps env pkg = do ] Just pkgInfo -> return $ Right $ unitDepends pkgInfo -newtype TypecheckHelpers +data TypecheckHelpers = TypecheckHelpers { getLinkables :: [NormalizedFilePath] -> IO [LinkableResult] -- ^ hls-graph action to get linkables for files + , getModuleGraph :: IO DependencyInformation } typecheckModule :: IdeDefer @@ -271,6 +278,9 @@ captureSplicesAndDeps TypecheckHelpers{..} env k = do (icInteractiveModule ictxt) stg_expr [] Nothing +#if MIN_VERSION_ghc(9,11,0) + [] -- spt_entries +#endif -- Exclude wired-in names because we may not have read -- their interface files, so getLinkDeps will fail @@ -294,19 +304,21 @@ captureSplicesAndDeps TypecheckHelpers{..} env k = do mods_transitive_list = mapMaybe nodeKeyToInstalledModule $ Set.toList mods_transitive - ; moduleLocs <- readIORef (fcModuleCache $ hsc_FC hsc_env) - ; lbs <- getLinkables [toNormalizedFilePath' file + ; moduleLocs <- getModuleGraph + ; lbs <- getLinkables [file | installedMod <- mods_transitive_list - , let ifr = fromJust $ lookupInstalledModuleEnv moduleLocs installedMod - file = case ifr of - InstalledFound loc _ -> - fromJust $ ml_hs_file loc - _ -> panic "hscCompileCoreExprHook: module not found" + , let file = fromJust $ lookupModuleFile (installedMod { moduleUnit = RealUnit (Definite $ moduleUnit installedMod) }) moduleLocs ] ; let hsc_env' = loadModulesHome (map linkableHomeMod lbs) hsc_env {- load it -} +#if MIN_VERSION_ghc(9,11,0) + ; bco_time <- getCurrentTime + ; (fv_hvs, lbss, pkgs) <- loadDecls (hscInterp hsc_env') hsc_env' srcspan $ + Linkable bco_time (icInteractiveModule ictxt) $ NE.singleton $ BCOs bcos +#else ; (fv_hvs, lbss, pkgs) <- loadDecls (hscInterp hsc_env') hsc_env' srcspan bcos +#endif ; let hval = (expectJust "hscCompileCoreExpr'" $ lookup (idName binding_id) fv_hvs, lbss, pkgs) ; modifyIORef' var (flip extendModuleEnvList [(mi_module $ hm_iface hm, linkableHash lb) | lb <- lbs, let hm = linkableHomeMod lb]) @@ -430,7 +442,14 @@ mkHiFileResultNoCompile session tcm = do details <- makeSimpleDetails hsc_env_tmp tcGblEnv sf <- finalSafeMode (ms_hspp_opts ms) tcGblEnv iface' <- mkIfaceTc hsc_env_tmp sf details ms Nothing tcGblEnv - let iface = iface' { mi_globals = Nothing, mi_usages = filterUsages (mi_usages iface') } -- See Note [Clearing mi_globals after generating an iface] + -- See Note [Clearing mi_globals after generating an iface] + let iface = iface' +#if MIN_VERSION_ghc(9,11,0) + & set_mi_top_env Nothing + & set_mi_usages (filterUsages (mi_usages iface')) +#else + { mi_globals = Nothing, mi_usages = filterUsages (mi_usages iface') } +#endif pure $! mkHiFileResult ms iface details (tmrRuntimeModules tcm) Nothing mkHiFileResultCompile @@ -456,13 +475,26 @@ mkHiFileResultCompile se session' tcm simplified_guts = catchErrs $ do #endif details ms +#if MIN_VERSION_ghc(9,11,0) + (tcg_import_decls (tmrTypechecked tcm)) +#endif simplified_guts final_iface' <- mkFullIface session partial_iface Nothing #if MIN_VERSION_ghc(9,4,2) Nothing #endif - let final_iface = final_iface' {mi_globals = Nothing, mi_usages = filterUsages (mi_usages final_iface')} -- See Note [Clearing mi_globals after generating an iface] +#if MIN_VERSION_ghc(9,11,0) + NoStubs [] +#endif + -- See Note [Clearing mi_globals after generating an iface] + let final_iface = final_iface' +#if MIN_VERSION_ghc(9,11,0) + & set_mi_top_env Nothing + & set_mi_usages (filterUsages (mi_usages final_iface')) +#else + {mi_globals = Nothing, mi_usages = filterUsages (mi_usages final_iface')} +#endif -- Write the core file now core_file <- do @@ -470,7 +502,7 @@ mkHiFileResultCompile se session' tcm simplified_guts = catchErrs $ do core_file = codeGutsToCoreFile iface_hash guts iface_hash = getModuleHash final_iface core_hash1 <- atomicFileWrite se core_fp $ \fp -> - writeBinCoreFile fp core_file + writeBinCoreFile (hsc_dflags session) fp core_file -- We want to drop references to guts and read in a serialized, compact version -- of the core file from disk (as it is deserialised lazily) -- This is because we don't want to keep the guts in memory for every file in @@ -626,11 +658,13 @@ generateObjectCode session summary guts = do case obj of Nothing -> throwGhcExceptionIO $ Panic "compileFile didn't generate object code" Just x -> pure x - let unlinked = DotO dot_o_fp -- Need time to be the modification time for recompilation checking t <- liftIO $ getModificationTime dot_o_fp - let linkable = LM t mod [unlinked] - +#if MIN_VERSION_ghc(9,11,0) + let linkable = Linkable t mod (pure $ DotO dot_o_fp ModuleObject) +#else + let linkable = LM t mod [DotO dot_o_fp] +#endif pure (map snd warnings, linkable) newtype CoreFileTime = CoreFileTime UTCTime @@ -639,15 +673,22 @@ generateByteCode :: CoreFileTime -> HscEnv -> ModSummary -> CgGuts -> IO (IdeRes generateByteCode (CoreFileTime time) hscEnv summary guts = do fmap (either (, Nothing) (second Just)) $ catchSrcErrors (hsc_dflags hscEnv) "bytecode" $ do +#if MIN_VERSION_ghc(9,11,0) + (warnings, (_, bytecode)) <- +#else (warnings, (_, bytecode, sptEntries)) <- +#endif withWarnings "bytecode" $ \_tweak -> do let session = _tweak (hscSetFlags (ms_hspp_opts summary) hscEnv) -- TODO: maybe settings ms_hspp_opts is unnecessary? summary' = summary { ms_hspp_opts = hsc_dflags session } hscInteractive session (mkCgInteractiveGuts guts) (ms_location summary') - let unlinked = BCOs bytecode sptEntries - let linkable = LM time (ms_mod summary) [unlinked] +#if MIN_VERSION_ghc(9,11,0) + let linkable = Linkable time (ms_mod summary) (pure $ BCOs bytecode) +#else + let linkable = LM time (ms_mod summary) [BCOs bytecode sptEntries] +#endif pure (map snd warnings, linkable) demoteTypeErrorsToWarnings :: ParsedModule -> ParsedModule @@ -748,21 +789,41 @@ atomicFileWrite se targetPath write = do (write tempFilePath >>= \x -> renameFile tempFilePath targetPath >> atomically (resetInterfaceStore se (toNormalizedFilePath' targetPath)) >> pure x) `onException` cleanUp -generateHieAsts :: HscEnv -> TcModuleResult -> IO ([FileDiagnostic], Maybe (HieASTs Type)) +generateHieAsts :: HscEnv -> TcModuleResult +#if MIN_VERSION_ghc(9,11,0) + -> IO ([FileDiagnostic], Maybe (HieASTs Type, NameEntityInfo)) +#else + -> IO ([FileDiagnostic], Maybe (HieASTs Type)) +#endif generateHieAsts hscEnv tcm = handleGenerationErrors' dflags "extended interface generation" $ runHsc hscEnv $ do -- These varBinds use unitDataConId but it could be anything as the id name is not used -- during the hie file generation process. It's a workaround for the fact that the hie modules -- don't export an interface which allows for additional information to be added to hie files. - let fake_splice_binds = Util.listToBag (map (mkVarBind unitDataConId) (spliceExpressions $ tmrTopLevelSplices tcm)) + let fake_splice_binds = +#if !MIN_VERSION_ghc(9,11,0) + Util.listToBag $ +#endif + map (mkVarBind unitDataConId) (spliceExpressions $ tmrTopLevelSplices tcm) real_binds = tcg_binds $ tmrTypechecked tcm + all_binds = +#if MIN_VERSION_ghc(9,11,0) + fake_splice_binds ++ real_binds +#else + fake_splice_binds `Util.unionBags` real_binds +#endif ts = tmrTypechecked tcm :: TcGblEnv top_ev_binds = tcg_ev_binds ts :: Util.Bag EvBind insts = tcg_insts ts :: [ClsInst] tcs = tcg_tcs ts :: [TyCon] + hie_asts = GHC.enrichHie all_binds (tmrRenamed tcm) top_ev_binds insts tcs pure $ Just $ - GHC.enrichHie (fake_splice_binds `Util.unionBags` real_binds) (tmrRenamed tcm) top_ev_binds insts tcs +#if MIN_VERSION_ghc(9,11,0) + hie_asts (tcg_type_env ts) +#elif MIN_VERSION_ghc(9,3,0) + hie_asts +#endif where dflags = hsc_dflags hscEnv @@ -850,7 +911,14 @@ indexHieFile se mod_summary srcPath !hash hf = do toJSON $ fromNormalizedFilePath srcPath whenJust mdone $ \_ -> progressUpdate indexProgressReporting ProgressCompleted -writeAndIndexHieFile :: HscEnv -> ShakeExtras -> ModSummary -> NormalizedFilePath -> [GHC.AvailInfo] -> HieASTs Type -> BS.ByteString -> IO [FileDiagnostic] +writeAndIndexHieFile + :: HscEnv -> ShakeExtras -> ModSummary -> NormalizedFilePath -> [GHC.AvailInfo] +#if MIN_VERSION_ghc(9,11,0) + -> (HieASTs Type, NameEntityInfo) +#else + -> HieASTs Type +#endif + -> BS.ByteString -> IO [FileDiagnostic] writeAndIndexHieFile hscEnv se mod_summary srcPath exports ast source = handleGenerationErrors dflags "extended interface write/compression" $ do hf <- runHsc hscEnv $ @@ -904,8 +972,46 @@ handleGenerationErrors' dflags source action = -- Add the current ModSummary to the graph, along with the -- HomeModInfo's of all direct dependencies (by induction hypothesis all -- transitive dependencies will be contained in envs) -mergeEnvs :: HscEnv -> ModuleGraph -> ModSummary -> [HomeModInfo] -> [HscEnv] -> IO HscEnv -mergeEnvs env mg ms extraMods envs = do +mergeEnvs :: HscEnv + -> ModuleGraph + -> DependencyInformation + -> ModSummary + -> [HomeModInfo] + -> [HscEnv] + -> IO HscEnv +mergeEnvs env mg dep_info ms extraMods envs = do +#if MIN_VERSION_ghc(9,11,0) + return $! loadModulesHome extraMods $ + let newHug = foldl' mergeHUG (hsc_HUG env) (map hsc_HUG envs) in + (hscUpdateHUG (const newHug) env){ + hsc_mod_graph = mg, + hsc_FC = (hsc_FC env) + { addToFinderCache = \gwib@(GWIB im _) val -> + if moduleUnit im `elem` hsc_all_home_unit_ids env + then pure () + else addToFinderCache (hsc_FC env) gwib val + , lookupFinderCache = \gwib@(GWIB im _) -> + if moduleUnit im `elem` hsc_all_home_unit_ids env + then case lookupModuleFile (im { moduleUnit = RealUnit (Definite $ moduleUnit im) }) dep_info of + Nothing -> pure Nothing + Just fs -> let ml = fromJust $ do + id <- lookupPathToId (depPathIdMap dep_info) fs + artifactModLocation (idToModLocation (depPathIdMap dep_info) id) + in pure $ Just $ InstalledFound ml im + else lookupFinderCache (hsc_FC env) gwib + } + } + + where + mergeHUG (UnitEnvGraph a) (UnitEnvGraph b) = UnitEnvGraph $ Map.unionWith mergeHUE a b + mergeHUE a b = a { homeUnitEnv_hpt = mergeUDFM (homeUnitEnv_hpt a) (homeUnitEnv_hpt b) } + mergeUDFM = plusUDFM_C combineModules + + combineModules a b + | HsSrcFile <- mi_hsc_src (hm_iface a) = a + | otherwise = b + +#elif MIN_VERSION_ghc(9,3,0) let im = Compat.installedModule (toUnitId $ moduleUnit $ ms_mod ms) (moduleName (ms_mod ms)) ifr = InstalledFound (ms_location ms) im curFinderCache = Compat.extendInstalledModuleEnv Compat.emptyInstalledModuleEnv im ifr @@ -939,6 +1045,7 @@ mergeEnvs env mg ms extraMods envs = do fcModules' <- newIORef $! foldl' (plusInstalledModuleEnv combineModuleLocations) cur fcModules fcFiles' <- newIORef $! Map.unions fcFiles pure $ FinderCache fcModules' fcFiles' +#endif withBootSuffix :: HscSource -> ModLocation -> ModLocation @@ -1249,6 +1356,7 @@ data RecompilationInfo m , old_value :: Maybe (HiFileResult, FileVersion) , get_file_version :: NormalizedFilePath -> m (Maybe FileVersion) , get_linkable_hashes :: [NormalizedFilePath] -> m [BS.ByteString] + , get_module_graph :: m DependencyInformation , regenerate :: Maybe LinkableType -> m ([FileDiagnostic], Maybe HiFileResult) -- ^ Action to regenerate an interface } @@ -1331,7 +1439,7 @@ loadInterface session ms linkableNeeded RecompilationInfo{..} = do | not (mi_used_th iface) = emptyModuleEnv | otherwise = parseRuntimeDeps (md_anns details) -- Peform the fine grained recompilation check for TH - maybe_recomp <- checkLinkableDependencies session get_linkable_hashes runtime_deps + maybe_recomp <- checkLinkableDependencies session get_linkable_hashes get_module_graph runtime_deps case maybe_recomp of Just msg -> do_regenerate msg Nothing @@ -1368,16 +1476,10 @@ parseRuntimeDeps anns = mkModuleEnv $ mapMaybe go anns -- the runtime dependencies of the module, to check if any of them are out of date -- Hopefully 'runtime_deps' will be empty if the module didn't actually use TH -- See Note [Recompilation avoidance in the presence of TH] -checkLinkableDependencies :: MonadIO m => HscEnv -> ([NormalizedFilePath] -> m [BS.ByteString]) -> ModuleEnv BS.ByteString -> m (Maybe RecompileRequired) -checkLinkableDependencies hsc_env get_linkable_hashes runtime_deps = do - moduleLocs <- liftIO $ readIORef (fcModuleCache $ hsc_FC hsc_env) - let go (mod, hash) = do - ifr <- lookupInstalledModuleEnv moduleLocs $ Compat.installedModule (toUnitId $ moduleUnit mod) (moduleName mod) - case ifr of - InstalledFound loc _ -> do - hs <- ml_hs_file loc - pure (toNormalizedFilePath' hs,hash) - _ -> Nothing +checkLinkableDependencies :: MonadIO m => HscEnv -> ([NormalizedFilePath] -> m [BS.ByteString]) -> m DependencyInformation -> ModuleEnv BS.ByteString -> m (Maybe RecompileRequired) +checkLinkableDependencies hsc_env get_linkable_hashes get_module_graph runtime_deps = do + graph <- get_module_graph + let go (mod, hash) = (,hash) <$> lookupModuleFile mod graph hs_files = mapM go (moduleEnvToList runtime_deps) case hs_files of Nothing -> error "invalid module graph" @@ -1423,7 +1525,11 @@ coreFileToCgGuts session iface details core_file = do tyCons = typeEnvTyCons (md_types details) #if MIN_VERSION_ghc(9,5,0) -- In GHC 9.6, the implicit binds are tidied and part of core_binds - pure $ CgGuts this_mod tyCons core_binds [] NoStubs [] mempty (emptyHpcInfo False) Nothing [] + pure $ CgGuts this_mod tyCons core_binds [] NoStubs [] mempty +#if !MIN_VERSION_ghc(9,11,0) + (emptyHpcInfo False) +#endif + Nothing [] #else pure $ CgGuts this_mod tyCons (_implicit_binds ++ core_binds) [] NoStubs [] mempty (emptyHpcInfo False) Nothing [] #endif @@ -1499,6 +1605,22 @@ pathToModuleName = mkModuleName . map rep rep ':' = '_' rep c = c +-- | Initialising plugins looks in the finder cache, but we know that the plugin doesn't come from a home module, so don't +-- error out when we don't find it +setNonHomeFCHook :: HscEnv -> HscEnv +setNonHomeFCHook hsc_env = +#if MIN_VERSION_ghc(9,11,0) + hsc_env { hsc_FC = (hsc_FC hsc_env) + { lookupFinderCache = \m@(GWIB im _) -> + if moduleUnit im `elem` hsc_all_home_unit_ids hsc_env + then pure (Just $ InstalledNotFound [] Nothing) + else lookupFinderCache (hsc_FC hsc_env) m + } + } +#else + hsc_env +#endif + {- Note [Guidelines For Using CPP In GHCIDE Import Statements] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ GHCIDE's interface with GHC is extensive, and unfortunately, because we have diff --git a/ghcide/src/Development/IDE/Core/RuleTypes.hs b/ghcide/src/Development/IDE/Core/RuleTypes.hs index fd6ef75cda..c4f88de047 100644 --- a/ghcide/src/Development/IDE/Core/RuleTypes.hs +++ b/ghcide/src/Development/IDE/Core/RuleTypes.hs @@ -24,7 +24,8 @@ import qualified Data.Map as M import Data.Time.Clock.POSIX import Data.Typeable import Development.IDE.GHC.Compat hiding - (HieFileResult) + (HieFileResult, + assert) import Development.IDE.GHC.Compat.Util import Development.IDE.GHC.CoreFile import Development.IDE.GHC.Util @@ -83,7 +84,7 @@ type instance RuleResult GetKnownTargets = KnownTargets type instance RuleResult GenerateCore = ModGuts data GenerateCore = GenerateCore - deriving (Eq, Show, Typeable, Generic) + deriving (Eq, Show, Generic) instance Hashable GenerateCore instance NFData GenerateCore @@ -103,12 +104,12 @@ instance NFData LinkableResult where rnf = rwhnf data GetLinkable = GetLinkable - deriving (Eq, Show, Typeable, Generic) + deriving (Eq, Show, Generic) instance Hashable GetLinkable instance NFData GetLinkable data GetImportMap = GetImportMap - deriving (Eq, Show, Typeable, Generic) + deriving (Eq, Show, Generic) instance Hashable GetImportMap instance NFData GetImportMap @@ -282,6 +283,8 @@ type instance RuleResult GetFileContents = (FileVersion, Maybe Rope) type instance RuleResult GetFileExists = Bool +type instance RuleResult GetFileHash = Fingerprint + type instance RuleResult AddWatchedFile = Bool @@ -332,16 +335,22 @@ instance Hashable GetFileContents instance NFData GetFileContents data GetFileExists = GetFileExists - deriving (Eq, Show, Typeable, Generic) + deriving (Eq, Show, Generic) instance NFData GetFileExists instance Hashable GetFileExists +data GetFileHash = GetFileHash + deriving (Eq, Show, Generic) + +instance NFData GetFileHash +instance Hashable GetFileHash + data FileOfInterestStatus = OnDisk | Modified { firstOpen :: !Bool -- ^ was this file just opened } - deriving (Eq, Show, Typeable, Generic) + deriving (Eq, Show, Generic) instance Hashable FileOfInterestStatus instance NFData FileOfInterestStatus @@ -349,7 +358,7 @@ instance Pretty FileOfInterestStatus where pretty = viaShow data IsFileOfInterestResult = NotFOI | IsFOI FileOfInterestStatus - deriving (Eq, Show, Typeable, Generic) + deriving (Eq, Show, Generic) instance Hashable IsFileOfInterestResult instance NFData IsFileOfInterestResult @@ -381,17 +390,17 @@ type instance RuleResult GetModSummary = ModSummaryResult type instance RuleResult GetModSummaryWithoutTimestamps = ModSummaryResult data GetParsedModule = GetParsedModule - deriving (Eq, Show, Typeable, Generic) + deriving (Eq, Show, Generic) instance Hashable GetParsedModule instance NFData GetParsedModule data GetParsedModuleWithComments = GetParsedModuleWithComments - deriving (Eq, Show, Typeable, Generic) + deriving (Eq, Show, Generic) instance Hashable GetParsedModuleWithComments instance NFData GetParsedModuleWithComments data GetLocatedImports = GetLocatedImports - deriving (Eq, Show, Typeable, Generic) + deriving (Eq, Show, Generic) instance Hashable GetLocatedImports instance NFData GetLocatedImports @@ -399,42 +408,42 @@ instance NFData GetLocatedImports type instance RuleResult NeedsCompilation = Maybe LinkableType data NeedsCompilation = NeedsCompilation - deriving (Eq, Show, Typeable, Generic) + deriving (Eq, Show, Generic) instance Hashable NeedsCompilation instance NFData NeedsCompilation data GetModuleGraph = GetModuleGraph - deriving (Eq, Show, Typeable, Generic) + deriving (Eq, Show, Generic) instance Hashable GetModuleGraph instance NFData GetModuleGraph data ReportImportCycles = ReportImportCycles - deriving (Eq, Show, Typeable, Generic) + deriving (Eq, Show, Generic) instance Hashable ReportImportCycles instance NFData ReportImportCycles data TypeCheck = TypeCheck - deriving (Eq, Show, Typeable, Generic) + deriving (Eq, Show, Generic) instance Hashable TypeCheck instance NFData TypeCheck data GetDocMap = GetDocMap - deriving (Eq, Show, Typeable, Generic) + deriving (Eq, Show, Generic) instance Hashable GetDocMap instance NFData GetDocMap data GetHieAst = GetHieAst - deriving (Eq, Show, Typeable, Generic) + deriving (Eq, Show, Generic) instance Hashable GetHieAst instance NFData GetHieAst data GetBindings = GetBindings - deriving (Eq, Show, Typeable, Generic) + deriving (Eq, Show, Generic) instance Hashable GetBindings instance NFData GetBindings data GhcSession = GhcSession - deriving (Eq, Show, Typeable, Generic) + deriving (Eq, Show, Generic) instance Hashable GhcSession instance NFData GhcSession @@ -443,7 +452,7 @@ newtype GhcSessionDeps = GhcSessionDeps_ -- Required for interactive evaluation, but leads to more cache invalidations fullModSummary :: Bool } - deriving newtype (Eq, Typeable, Hashable, NFData) + deriving newtype (Eq, Hashable, NFData) instance Show GhcSessionDeps where show (GhcSessionDeps_ False) = "GhcSessionDeps" @@ -453,45 +462,45 @@ pattern GhcSessionDeps :: GhcSessionDeps pattern GhcSessionDeps = GhcSessionDeps_ False data GetModIfaceFromDisk = GetModIfaceFromDisk - deriving (Eq, Show, Typeable, Generic) + deriving (Eq, Show, Generic) instance Hashable GetModIfaceFromDisk instance NFData GetModIfaceFromDisk data GetModIfaceFromDiskAndIndex = GetModIfaceFromDiskAndIndex - deriving (Eq, Show, Typeable, Generic) + deriving (Eq, Show, Generic) instance Hashable GetModIfaceFromDiskAndIndex instance NFData GetModIfaceFromDiskAndIndex data GetModIface = GetModIface - deriving (Eq, Show, Typeable, Generic) + deriving (Eq, Show, Generic) instance Hashable GetModIface instance NFData GetModIface data IsFileOfInterest = IsFileOfInterest - deriving (Eq, Show, Typeable, Generic) + deriving (Eq, Show, Generic) instance Hashable IsFileOfInterest instance NFData IsFileOfInterest data GetModSummaryWithoutTimestamps = GetModSummaryWithoutTimestamps - deriving (Eq, Show, Typeable, Generic) + deriving (Eq, Show, Generic) instance Hashable GetModSummaryWithoutTimestamps instance NFData GetModSummaryWithoutTimestamps data GetModSummary = GetModSummary - deriving (Eq, Show, Typeable, Generic) + deriving (Eq, Show, Generic) instance Hashable GetModSummary instance NFData GetModSummary -- See Note [Client configuration in Rules] -- | Get the client config stored in the ide state data GetClientSettings = GetClientSettings - deriving (Eq, Show, Typeable, Generic) + deriving (Eq, Show, Generic) instance Hashable GetClientSettings instance NFData GetClientSettings type instance RuleResult GetClientSettings = Hashed (Maybe Value) -data AddWatchedFile = AddWatchedFile deriving (Eq, Show, Typeable, Generic) +data AddWatchedFile = AddWatchedFile deriving (Eq, Show, Generic) instance Hashable AddWatchedFile instance NFData AddWatchedFile @@ -511,7 +520,7 @@ data IdeGhcSession = IdeGhcSession instance Show IdeGhcSession where show _ = "IdeGhcSession" instance NFData IdeGhcSession where rnf !_ = () -data GhcSessionIO = GhcSessionIO deriving (Eq, Show, Typeable, Generic) +data GhcSessionIO = GhcSessionIO deriving (Eq, Show, Generic) instance Hashable GhcSessionIO instance NFData GhcSessionIO diff --git a/ghcide/src/Development/IDE/Core/Rules.hs b/ghcide/src/Development/IDE/Core/Rules.hs index 5650300a4c..74eddf55f1 100644 --- a/ghcide/src/Development/IDE/Core/Rules.hs +++ b/ghcide/src/Development/IDE/Core/Rules.hs @@ -174,6 +174,7 @@ import System.Info.Extra (isWindows) import qualified Data.IntMap as IM import GHC.Fingerprint +import GHC.Driver.Env (hsc_all_home_unit_ids) data Log = LogShake Shake.Log @@ -519,7 +520,12 @@ persistentHieFileRule recorder = addPersistentRule GetHieAst $ \file -> runMaybe getHieAstRuleDefinition :: NormalizedFilePath -> HscEnv -> TcModuleResult -> Action (IdeResult HieAstResult) getHieAstRuleDefinition f hsc tmr = do - (diags, masts) <- liftIO $ generateHieAsts hsc tmr + (diags, masts') <- liftIO $ generateHieAsts hsc tmr +#if MIN_VERSION_ghc(9,11,0) + let masts = fst <$> masts' +#else + let masts = masts' +#endif se <- getShakeExtras isFoi <- use_ IsFileOfInterest f @@ -529,7 +535,7 @@ getHieAstRuleDefinition f hsc tmr = do LSP.sendNotification (SMethod_CustomMethod (Proxy @"ghcide/reference/ready")) $ toJSON $ fromNormalizedFilePath f pure [] - _ | Just asts <- masts -> do + _ | Just asts <- masts' -> do source <- getSourceFileSource f let exports = tcg_exports $ tmrTypechecked tmr modSummary = tmrModSummary tmr @@ -610,6 +616,13 @@ knownFilesRule recorder = defineEarlyCutOffNoFile (cmapWithPrio LogShake recorde fs <- knownTargets pure (LBS.toStrict $ B.encode $ hash fs, unhashed fs) +getFileHashRule :: Recorder (WithPriority Log) -> Rules () +getFileHashRule recorder = + defineEarlyCutoff (cmapWithPrio LogShake recorder) $ Rule $ \GetFileHash file -> do + void $ use_ GetModificationTime file + fileHash <- liftIO $ Util.getFileHash (fromNormalizedFilePath file) + return (Just (fingerprintToBS fileHash), ([], Just fileHash)) + getModuleGraphRule :: Recorder (WithPriority Log) -> Rules () getModuleGraphRule recorder = defineEarlyCutOffNoFile (cmapWithPrio LogShake recorder) $ \GetModuleGraph -> do fs <- toKnownFiles <$> useNoFile_ GetKnownTargets @@ -646,6 +659,7 @@ typeCheckRuleDefinition hsc pm = do unlift <- askUnliftIO let dets = TypecheckHelpers { getLinkables = unliftIO unlift . uses_ GetLinkable + , getModuleGraph = unliftIO unlift $ useNoFile_ GetModuleGraph } addUsageDependencies $ liftIO $ typecheckModule defer hsc dets pm @@ -757,7 +771,8 @@ ghcSessionDepsDefinition fullModSummary GhcSessionDepsConfig{..} env file = do nubOrdOn mkNodeKey (ModuleNode final_deps ms : concatMap mgModSummaries' mgs) liftIO $ evaluate $ liftRnf rwhnf module_graph_nodes return $ mkModuleGraph module_graph_nodes - session' <- liftIO $ mergeEnvs hsc mg ms inLoadOrder depSessions + de <- useNoFile_ GetModuleGraph + session' <- liftIO $ mergeEnvs hsc mg de ms inLoadOrder depSessions -- Here we avoid a call to to `newHscEnvEqWithImportPaths`, which creates a new -- ExportsMap when it is called. We only need to create the ExportsMap once per @@ -786,9 +801,11 @@ getModIfaceFromDiskRule recorder = defineEarlyCutoff (cmapWithPrio LogShake reco , old_value = m_old , get_file_version = use GetModificationTime_{missingFileDiagnostics = False} , get_linkable_hashes = \fs -> map (snd . fromJust . hirCoreFp) <$> uses_ GetModIface fs + , get_module_graph = useNoFile_ GetModuleGraph , regenerate = regenerateHiFile session f ms } - r <- loadInterface (hscEnv session) ms linkableType recompInfo + hsc_env' <- setFileCacheHook (hscEnv session) + r <- loadInterface hsc_env' ms linkableType recompInfo case r of (diags, Nothing) -> return (Nothing, (diags, Nothing)) (diags, Just x) -> do @@ -856,7 +873,7 @@ getModSummaryRule displayTHWarning recorder = do defineEarlyCutoff (cmapWithPrio LogShake recorder) $ Rule $ \GetModSummary f -> do session' <- hscEnv <$> use_ GhcSession f modify_dflags <- getModifyDynFlags dynFlagsModifyGlobal - let session = hscSetFlags (modify_dflags $ hsc_dflags session') session' + let session = setNonHomeFCHook $ hscSetFlags (modify_dflags $ hsc_dflags session') session' -- TODO wz1000 (modTime, mFileContent) <- getFileModTimeContents f let fp = fromNormalizedFilePath f modS <- liftIO $ runExceptT $ @@ -887,8 +904,9 @@ getModSummaryRule displayTHWarning recorder = do generateCore :: RunSimplifier -> NormalizedFilePath -> Action (IdeResult ModGuts) generateCore runSimplifier file = do packageState <- hscEnv <$> use_ GhcSessionDeps file + hsc' <- setFileCacheHook packageState tm <- use_ TypeCheck file - liftIO $ compileModule runSimplifier packageState (tmrModSummary tm) (tmrTypechecked tm) + liftIO $ compileModule runSimplifier hsc' (tmrModSummary tm) (tmrTypechecked tm) generateCoreRule :: Recorder (WithPriority Log) -> Rules () generateCoreRule recorder = @@ -903,14 +921,15 @@ getModIfaceRule recorder = defineEarlyCutoff (cmapWithPrio LogShake recorder) $ tmr <- use_ TypeCheck f linkableType <- getLinkableType f hsc <- hscEnv <$> use_ GhcSessionDeps f + hsc' <- setFileCacheHook hsc let compile = fmap ([],) $ use GenerateCore f se <- getShakeExtras - (diags, !mbHiFile) <- writeCoreFileIfNeeded se hsc linkableType compile tmr + (diags, !mbHiFile) <- writeCoreFileIfNeeded se hsc' linkableType compile tmr let fp = hiFileFingerPrint <$> mbHiFile hiDiags <- case mbHiFile of Just hiFile | OnDisk <- status - , not (tmrDeferredError tmr) -> liftIO $ writeHiFile se hsc hiFile + , not (tmrDeferredError tmr) -> liftIO $ writeHiFile se hsc' hiFile _ -> pure [] return (fp, (diags++hiDiags, mbHiFile)) NotFOI -> do @@ -934,12 +953,21 @@ incrementRebuildCount = do count <- getRebuildCountVar <$> getIdeGlobalAction liftIO $ atomically $ modifyTVar' count (+1) +setFileCacheHook :: HscEnv -> Action HscEnv +setFileCacheHook old_hsc_env = do +#if MIN_VERSION_ghc(9,11,0) + unlift <- askUnliftIO + return $ old_hsc_env { hsc_FC = (hsc_FC old_hsc_env) { lookupFileCache = unliftIO unlift . use_ GetFileHash . toNormalizedFilePath' } } +#else + return old_hsc_env +#endif + -- | Also generates and indexes the `.hie` file, along with the `.o` file if needed -- Invariant maintained is that if the `.hi` file was successfully written, then the -- `.hie` and `.o` file (if needed) were also successfully written regenerateHiFile :: HscEnvEq -> NormalizedFilePath -> ModSummary -> Maybe LinkableType -> Action ([FileDiagnostic], Maybe HiFileResult) regenerateHiFile sess f ms compNeeded = do - let hsc = hscEnv sess + hsc <- setFileCacheHook (hscEnv sess) opt <- getIdeOptions -- Embed haddocks in the interface file @@ -1038,6 +1066,13 @@ getLinkableRule recorder = HiFileResult{hirModSummary, hirModIface, hirModDetails, hirCoreFp} <- use_ GetModIface f let obj_file = ml_obj_file (ms_location hirModSummary) core_file = ml_core_file (ms_location hirModSummary) +#if MIN_VERSION_ghc(9,11,0) + mkLinkable t mod l = Linkable t mod (pure l) + dotO o = DotO o ModuleObject +#else + mkLinkable t mod l = LM t mod [l] + dotO = DotO +#endif case hirCoreFp of Nothing -> error $ "called GetLinkable for a file without a linkable: " ++ show f Just (bin_core, fileHash) -> do @@ -1063,10 +1098,15 @@ getLinkableRule recorder = else pure Nothing case mobj_time of Just obj_t - | obj_t >= core_t -> pure ([], Just $ HomeModInfo hirModIface hirModDetails (justObjects $ LM (posixSecondsToUTCTime obj_t) (ms_mod hirModSummary) [DotO obj_file])) + | obj_t >= core_t -> pure ([], Just $ HomeModInfo hirModIface hirModDetails (justObjects $ mkLinkable (posixSecondsToUTCTime obj_t) (ms_mod hirModSummary) (dotO obj_file))) _ -> liftIO $ coreFileToLinkable linkableType (hscEnv session) hirModSummary hirModIface hirModDetails bin_core (error "object doesn't have time") -- Record the linkable so we know not to unload it, and unload old versions - whenJust ((homeModInfoByteCode =<< hmi) <|> (homeModInfoObject =<< hmi)) $ \(LM time mod _) -> do + whenJust ((homeModInfoByteCode =<< hmi) <|> (homeModInfoObject =<< hmi)) +#if MIN_VERSION_ghc(9,11,0) + $ \(Linkable time mod _) -> do +#else + $ \(LM time mod _) -> do +#endif compiledLinkables <- getCompiledLinkables <$> getIdeGlobalAction liftIO $ modifyVar compiledLinkables $ \old -> do let !to_keep = extendModuleEnv old mod time @@ -1080,7 +1120,9 @@ getLinkableRule recorder = --just before returning it to be loaded. This has a substantial effect on recompile --times as the number of loaded modules and splices increases. -- - unload (hscEnv session) (map (\(mod', time') -> LM time' mod' []) $ moduleEnvToList to_keep) + --We use a dummy DotA linkable part to fake a NativeCode linkable. + --The unload function doesn't care about the exact linkable parts. + unload (hscEnv session) (map (\(mod', time') -> mkLinkable time' mod' (DotA "dummy")) $ moduleEnvToList to_keep) return (to_keep, ()) return (fileHash <$ hmi, (warns, LinkableResult <$> hmi <*> pure fileHash)) @@ -1178,12 +1220,13 @@ mainRule recorder RulesConfig{..} = do reportImportCyclesRule recorder typeCheckRule recorder getDocMapRule recorder - loadGhcSession recorder GhcSessionDepsConfig{fullModuleGraph} + loadGhcSession recorder def{fullModuleGraph} getModIfaceFromDiskRule recorder getModIfaceFromDiskAndIndexRule recorder getModIfaceRule recorder getModSummaryRule templateHaskellWarning recorder getModuleGraphRule recorder + getFileHashRule recorder knownFilesRule recorder getClientSettingsRule recorder getHieAstsRule recorder diff --git a/ghcide/src/Development/IDE/Core/Shake.hs b/ghcide/src/Development/IDE/Core/Shake.hs index ed27a2f608..97150339d0 100644 --- a/ghcide/src/Development/IDE/Core/Shake.hs +++ b/ghcide/src/Development/IDE/Core/Shake.hs @@ -1246,7 +1246,7 @@ defineEarlyCutoff' doDiagnostics cmp key file mbOld mode action = do (mbBs, (diags, mbRes)) <- actionCatch (do v <- action staleV; liftIO $ evaluate $ force v) $ \(e :: SomeException) -> do - pure (Nothing, ([ideErrorText file (T.pack $ show e) | not $ isBadDependency e],Nothing)) + pure (Nothing, ([ideErrorText file (T.pack $ show (key, file) ++ show e) | not $ isBadDependency e],Nothing)) ver <- estimateFileVersionUnsafely key mbRes file (bs, res) <- case mbRes of diff --git a/ghcide/src/Development/IDE/GHC/CPP.hs b/ghcide/src/Development/IDE/GHC/CPP.hs index 289794d2a5..50421cde80 100644 --- a/ghcide/src/Development/IDE/GHC/CPP.hs +++ b/ghcide/src/Development/IDE/GHC/CPP.hs @@ -34,6 +34,10 @@ import qualified GHC.SysTools.Cpp as Pipeline import qualified GHC.SysTools.Tasks as Pipeline #endif +#if MIN_VERSION_ghc(9,11,0) +import qualified GHC.SysTools.Tasks as Pipeline +#endif + addOptP :: String -> DynFlags -> DynFlags addOptP f = alterToolSettings $ \s -> s { toolSettings_opt_P = f : toolSettings_opt_P s diff --git a/ghcide/src/Development/IDE/GHC/Compat.hs b/ghcide/src/Development/IDE/GHC/Compat.hs index 5f66625ee5..6a2ae5b77a 100644 --- a/ghcide/src/Development/IDE/GHC/Compat.hs +++ b/ghcide/src/Development/IDE/GHC/Compat.hs @@ -338,10 +338,20 @@ type NameCacheUpdater = NameCache mkHieFile' :: ModSummary -> [Avail.AvailInfo] +#if MIN_VERSION_ghc(9,11,0) + -> (HieASTs Type, NameEntityInfo) +#else -> HieASTs Type +#endif -> BS.ByteString -> Hsc HieFile -mkHieFile' ms exports asts src = do +mkHieFile' ms exports +#if MIN_VERSION_ghc(9,11,0) + (asts, entityInfo) +#else + asts +#endif + src = do let Just src_file = ml_hs_file $ ms_location ms (asts',arr) = compressTypes asts return $ HieFile @@ -349,6 +359,9 @@ mkHieFile' ms exports asts src = do , hie_module = ms_mod ms , hie_types = arr , hie_asts = asts' +#if MIN_VERSION_ghc(9,11,0) + , hie_entity_infos = entityInfo +#endif -- mkIfaceExports sorts the AvailInfos for stability , hie_exports = mkIfaceExports exports , hie_hs_src = src @@ -444,13 +457,16 @@ data GhcVersion | GHC96 | GHC98 | GHC910 + | GHC912 deriving (Eq, Ord, Show, Enum) ghcVersionStr :: String ghcVersionStr = VERSION_ghc ghcVersion :: GhcVersion -#if MIN_VERSION_GLASGOW_HASKELL(9,10,0,0) +#if MIN_VERSION_GLASGOW_HASKELL(9,12,0,0) +ghcVersion = GHC912 +#elif MIN_VERSION_GLASGOW_HASKELL(9,10,0,0) ghcVersion = GHC910 #elif MIN_VERSION_GLASGOW_HASKELL(9,8,0,0) ghcVersion = GHC98 diff --git a/ghcide/src/Development/IDE/GHC/Compat/Core.hs b/ghcide/src/Development/IDE/GHC/Compat/Core.hs index 301aa980bd..3be432bfda 100644 --- a/ghcide/src/Development/IDE/GHC/Compat/Core.hs +++ b/ghcide/src/Development/IDE/GHC/Compat/Core.hs @@ -69,6 +69,11 @@ module Development.IDE.GHC.Compat.Core ( IfaceTyCon(..), ModIface, ModIface_(..), +#if MIN_VERSION_ghc(9,11,0) + pattern ModIface, + set_mi_top_env, + set_mi_usages, +#endif HscSource(..), WhereFrom(..), loadInterface, @@ -230,7 +235,11 @@ module Development.IDE.GHC.Compat.Core ( ModuleOrigin(..), PackageName(..), -- * Linker +#if MIN_VERSION_ghc(9,11,0) + LinkablePart(..), +#else Unlinked(..), +#endif Linkable(..), unload, -- * Hooks @@ -452,7 +461,7 @@ import GHC.Tc.Types.Evidence hiding ((<.>)) import GHC.Tc.Utils.Env import GHC.Tc.Utils.Monad hiding (Applicative (..), IORef, MonadFix (..), MonadIO (..), allM, - anyM, concatMapM, mapMaybeM, + anyM, concatMapM, mapMaybeM, foldMapM, (<$>)) import GHC.Tc.Utils.TcType as TcType import qualified GHC.Types.Avail as Avail @@ -530,16 +539,29 @@ import GHC.Unit.Module.Graph import GHC.Unit.Module.Imported import GHC.Unit.Module.ModDetails import GHC.Unit.Module.ModGuts +#if !MIN_VERSION_ghc(9,9,0) +import GHC.Hs (SrcSpanAnn') +#endif import GHC.Unit.Module.ModIface (IfaceExport, ModIface, - ModIface_ (..), mi_fix) + ModIface_ (..), mi_fix +#if MIN_VERSION_ghc(9,11,0) + , pattern ModIface + , set_mi_top_env + , set_mi_usages +#endif + ) import GHC.Unit.Module.ModSummary (ModSummary (..)) import GHC.Utils.Error (mkPlainErrorMsgEnvelope) import GHC.Utils.Panic import GHC.Utils.TmpFs import Language.Haskell.Syntax hiding (FunDep) + -- See Note [Guidelines For Using CPP In GHCIDE Import Statements] +#if MIN_VERSION_ghc(9,11,0) +import System.OsPath +#endif #if !MIN_VERSION_ghc(9,7,0) import GHC.Types.Avail (greNamePrintableName) @@ -550,7 +572,13 @@ import GHC.Hs (SrcSpanAnn') #endif mkHomeModLocation :: DynFlags -> ModuleName -> FilePath -> IO Module.ModLocation +#if MIN_VERSION_ghc(9,11,0) +mkHomeModLocation df mn f = + let osf = unsafeEncodeUtf f + in pure $ GHC.mkHomeModLocation (GHC.initFinderOpts df) mn osf +#else mkHomeModLocation df mn f = pure $ GHC.mkHomeModLocation (GHC.initFinderOpts df) mn f +#endif pattern RealSrcSpan :: SrcLoc.RealSrcSpan -> Maybe BufSpan -> SrcLoc.SrcSpan @@ -709,7 +737,7 @@ pattern GRE{gre_name, gre_par, gre_lcl, gre_imp} <- RdrName.GRE #endif ,gre_par, gre_lcl, gre_imp = (toList -> gre_imp)} -collectHsBindsBinders :: CollectPass p => Bag (XRec p (HsBindLR p idR)) -> [IdP p] +collectHsBindsBinders :: CollectPass p => LHsBindsLR p idR -> [IdP p] collectHsBindsBinders x = GHC.collectHsBindsBinders CollNoDictBinders x diff --git a/ghcide/src/Development/IDE/GHC/Compat/Driver.hs b/ghcide/src/Development/IDE/GHC/Compat/Driver.hs index c88d0963d6..3ad063936e 100644 --- a/ghcide/src/Development/IDE/GHC/Compat/Driver.hs +++ b/ghcide/src/Development/IDE/GHC/Compat/Driver.hs @@ -12,6 +12,12 @@ module Development.IDE.GHC.Compat.Driver ( hscTypecheckRenameWithDiagnostics ) where +#if MIN_VERSION_ghc(9,11,0) + +import GHC.Driver.Main (hscTypecheckRenameWithDiagnostics) + +#else + import Control.Monad import GHC.Core import GHC.Data.FastString @@ -145,3 +151,5 @@ hscSimpleIface :: HscEnv hscSimpleIface hsc_env tc_result summary = runHsc hsc_env $ hscSimpleIface' tc_result summary #endif + +#endif diff --git a/ghcide/src/Development/IDE/GHC/Compat/Iface.hs b/ghcide/src/Development/IDE/GHC/Compat/Iface.hs index e76de880d5..0a16f676e7 100644 --- a/ghcide/src/Development/IDE/GHC/Compat/Iface.hs +++ b/ghcide/src/Development/IDE/GHC/Compat/Iface.hs @@ -21,7 +21,11 @@ import GHC.Iface.Errors.Types (IfaceMessage) #endif writeIfaceFile :: HscEnv -> FilePath -> ModIface -> IO () +#if MIN_VERSION_ghc(9,11,0) +writeIfaceFile env fp iface = Iface.writeIface (hsc_logger env) (targetProfile $ hsc_dflags env) (Iface.flagsToIfCompression $ hsc_dflags env) fp iface +#elif MIN_VERSION_ghc(9,3,0) writeIfaceFile env fp iface = Iface.writeIface (hsc_logger env) (targetProfile $ hsc_dflags env) fp iface +#endif cannotFindModule :: HscEnv -> ModuleName -> FindResult -> SDoc cannotFindModule env modname fr = diff --git a/ghcide/src/Development/IDE/GHC/Compat/Parser.hs b/ghcide/src/Development/IDE/GHC/Compat/Parser.hs index 25d23bcad4..7ae9c2bab9 100644 --- a/ghcide/src/Development/IDE/GHC/Compat/Parser.hs +++ b/ghcide/src/Development/IDE/GHC/Compat/Parser.hs @@ -16,7 +16,9 @@ module Development.IDE.GHC.Compat.Parser ( Development.IDE.GHC.Compat.Parser.pm_mod_summary, Development.IDE.GHC.Compat.Parser.pm_extra_src_files, -- * API Annotations +#if !MIN_VERSION_ghc(9,11,0) Anno.AnnKeywordId(..), +#endif pattern EpaLineComment, pattern EpaBlockComment ) where diff --git a/ghcide/src/Development/IDE/GHC/CoreFile.hs b/ghcide/src/Development/IDE/GHC/CoreFile.hs index f2b58ee02e..015c5e3aff 100644 --- a/ghcide/src/Development/IDE/GHC/CoreFile.hs +++ b/ghcide/src/Development/IDE/GHC/CoreFile.hs @@ -26,6 +26,9 @@ import GHC.CoreToIface import GHC.Fingerprint import GHC.Iface.Binary import GHC.Iface.Env +#if MIN_VERSION_ghc(9,11,0) +import qualified GHC.Iface.Load as Iface +#endif import GHC.Iface.Recomp.Binary (fingerprintBinMem) import GHC.IfaceToCore import GHC.Types.Id.Make @@ -87,14 +90,20 @@ readBinCoreFile name_cache fat_hi_path = do return (file, fp) -- | Write a core file -writeBinCoreFile :: FilePath -> CoreFile -> IO Fingerprint -writeBinCoreFile core_path fat_iface = do +writeBinCoreFile :: DynFlags -> FilePath -> CoreFile -> IO Fingerprint +writeBinCoreFile _dflags core_path fat_iface = do bh <- openBinMem initBinMemSize let quietTrace = QuietBinIFace - putWithUserData quietTrace bh fat_iface + putWithUserData + quietTrace +#if MIN_VERSION_ghc(9,11,0) + (Iface.flagsToIfCompression _dflags) +#endif + bh + fat_iface -- And send the result to the file writeBinMem bh core_path @@ -141,7 +150,11 @@ getClassImplicitBinds cls | (op, val_index) <- classAllSelIds cls `zip` [0..] ] get_defn :: Id -> CoreBind -get_defn identifier = NonRec identifier (unfoldingTemplate (realIdUnfolding identifier)) +get_defn identifier = NonRec identifier templ + where + templ = case maybeUnfoldingTemplate (realIdUnfolding identifier) of + Nothing -> error "get_dfn: no unfolding template" + Just x -> x toIfaceTopBndr1 :: Module -> Id -> IfaceId toIfaceTopBndr1 mod identifier diff --git a/ghcide/src/Development/IDE/GHC/Orphans.hs b/ghcide/src/Development/IDE/GHC/Orphans.hs index 2ee19beeb2..4e832f9ee2 100644 --- a/ghcide/src/Development/IDE/GHC/Orphans.hs +++ b/ghcide/src/Development/IDE/GHC/Orphans.hs @@ -51,6 +51,17 @@ instance Show ModDetails where show = const "" instance NFData ModDetails where rnf = rwhnf instance NFData SafeHaskellMode where rnf = rwhnf instance Show Linkable where show = unpack . printOutputable +#if MIN_VERSION_ghc(9,11,0) +instance NFData Linkable where rnf (Linkable a b c) = rnf a `seq` rnf b `seq` rnf c +instance NFData LinkableObjectSort where rnf = rwhnf +instance NFData LinkablePart where + rnf (DotO a b) = rnf a `seq` rnf b + rnf (DotA f) = rnf f + rnf (DotDLL f) = rnf f + rnf (BCOs a) = seqCompiledByteCode a + rnf (CoreBindings wcb) = rnf wcb + rnf (LazyBCOs a b) = seqCompiledByteCode a `seq` rnf b +#else instance NFData Linkable where rnf (LM a b c) = rnf a `seq` rnf b `seq` rnf c instance NFData Unlinked where rnf (DotO f) = rnf f @@ -60,13 +71,23 @@ instance NFData Unlinked where #if MIN_VERSION_ghc(9,5,0) rnf (CoreBindings wcb) = rnf wcb rnf (LoadedBCOs us) = rnf us +#endif +#endif +#if MIN_VERSION_ghc(9,5,0) instance NFData WholeCoreBindings where +#if MIN_VERSION_ghc(9,11,0) + rnf (WholeCoreBindings bs m ml f) = rnf bs `seq` rnf m `seq` rnf ml `seq` rnf f +#else rnf (WholeCoreBindings bs m ml) = rnf bs `seq` rnf m `seq` rnf ml +#endif instance NFData ModLocation where +#if MIN_VERSION_ghc(9,11,0) + rnf (OsPathModLocation mf f1 f2 f3 f4 f5) = rnf mf `seq` rnf f1 `seq` rnf f2 `seq` rnf f3 `seq` rnf f4 `seq` rnf f5 +#else rnf (ModLocation mf f1 f2 f3 f4 f5) = rnf mf `seq` rnf f1 `seq` rnf f2 `seq` rnf f3 `seq` rnf f4 `seq` rnf f5 - +#endif #endif instance Show PackageFlag where show = unpack . printOutputable diff --git a/ghcide/src/Development/IDE/Import/DependencyInformation.hs b/ghcide/src/Development/IDE/Import/DependencyInformation.hs index 5372a1364a..d6e0f5614c 100644 --- a/ghcide/src/Development/IDE/Import/DependencyInformation.hs +++ b/ghcide/src/Development/IDE/Import/DependencyInformation.hs @@ -20,6 +20,7 @@ module Development.IDE.Import.DependencyInformation , insertImport , pathToId , idToPath + , idToModLocation , reachableModules , processDependencyInformation , transitiveDeps diff --git a/ghcide/src/Development/IDE/Import/FindImports.hs b/ghcide/src/Development/IDE/Import/FindImports.hs index 7fa287836b..79614f1809 100644 --- a/ghcide/src/Development/IDE/Import/FindImports.hs +++ b/ghcide/src/Development/IDE/Import/FindImports.hs @@ -29,6 +29,10 @@ import GHC.Unit.State import System.FilePath +#if MIN_VERSION_ghc(9,11,0) +import GHC.Driver.DynFlags +#endif + data Import = FileImport !ArtifactsLocation | PackageImport @@ -96,7 +100,11 @@ locateModuleFile import_dirss exts targetFor isSource modName = do -- current module. In particular, it will return Nothing for 'main' components -- as they can never be imported into another package. mkImportDirs :: HscEnv -> (UnitId, DynFlags) -> Maybe (UnitId, ([FilePath], S.Set ModuleName)) +#if MIN_VERSION_ghc(9,11,0) +mkImportDirs _env (i, flags) = Just (i, (importPaths flags, S.fromList $ map reexportTo $ reexportedModules flags)) +#else mkImportDirs _env (i, flags) = Just (i, (importPaths flags, reexportedModules flags)) +#endif -- | locate a module in either the file system or the package database. Where we go from *daml to -- Haskell @@ -146,7 +154,11 @@ locateModule env comp_info exts targetFor modName mbPkgName isSource = do -- about which module unit a imports. -- Without multi-component support it is hard to recontruct the dependency environment so -- unit a will have both unit b and unit c in scope. +#if MIN_VERSION_ghc(9,11,0) + map (\uid -> let this_df = homeUnitEnv_dflags (ue_findHomeUnitEnv uid ue) in (uid, importPaths this_df, S.fromList $ map reexportTo $ reexportedModules this_df)) hpt_deps +#else map (\uid -> let this_df = homeUnitEnv_dflags (ue_findHomeUnitEnv uid ue) in (uid, importPaths this_df, reexportedModules this_df)) hpt_deps +#endif ue = hsc_unit_env env units = homeUnitEnv_units $ ue_findHomeUnitEnv (homeUnitId_ dflags) ue hpt_deps :: [UnitId] diff --git a/ghcide/src/Development/IDE/Plugin/Completions/Types.hs b/ghcide/src/Development/IDE/Plugin/Completions/Types.hs index 2d950d66a9..338b969bab 100644 --- a/ghcide/src/Development/IDE/Plugin/Completions/Types.hs +++ b/ghcide/src/Development/IDE/Plugin/Completions/Types.hs @@ -16,7 +16,6 @@ import Data.Aeson import Data.Aeson.Types import Data.Hashable (Hashable) import Data.Text (Text) -import Data.Typeable (Typeable) import Development.IDE.GHC.Compat import Development.IDE.Graph (RuleResult) import Development.IDE.Spans.Common () @@ -31,12 +30,12 @@ type instance RuleResult LocalCompletions = CachedCompletions type instance RuleResult NonLocalCompletions = CachedCompletions data LocalCompletions = LocalCompletions - deriving (Eq, Show, Typeable, Generic) + deriving (Eq, Show, Generic) instance Hashable LocalCompletions instance NFData LocalCompletions data NonLocalCompletions = NonLocalCompletions - deriving (Eq, Show, Typeable, Generic) + deriving (Eq, Show, Generic) instance Hashable NonLocalCompletions instance NFData NonLocalCompletions diff --git a/ghcide/src/Development/IDE/Plugin/TypeLenses.hs b/ghcide/src/Development/IDE/Plugin/TypeLenses.hs index a1aa237de8..40ce1dda7b 100644 --- a/ghcide/src/Development/IDE/Plugin/TypeLenses.hs +++ b/ghcide/src/Development/IDE/Plugin/TypeLenses.hs @@ -1,3 +1,4 @@ +{-# LANGUAGE CPP #-} {-# LANGUAGE DeriveAnyClass #-} {-# LANGUAGE OverloadedLabels #-} {-# LANGUAGE TypeFamilies #-} @@ -321,7 +322,11 @@ gblBindingType (Just hsc) (Just gblEnv) = do let name = idName identifier hasSig name $ do env <- tcInitTidyEnv +#if MIN_VERSION_ghc(9,11,0) + let ty = tidyOpenType env (idType identifier) +#else let (_, ty) = tidyOpenType env (idType identifier) +#endif pure $ GlobalBindingTypeSig name (printName name <> " :: " <> showDoc (pprSigmaType ty)) (name `elemNameSet` exports) patToSig p = do let name = patSynName p diff --git a/ghcide/src/Development/IDE/Spans/AtPoint.hs b/ghcide/src/Development/IDE/Spans/AtPoint.hs index 4fafa3e952..a577cae32e 100644 --- a/ghcide/src/Development/IDE/Spans/AtPoint.hs +++ b/ghcide/src/Development/IDE/Spans/AtPoint.hs @@ -36,6 +36,7 @@ import Language.LSP.Protocol.Types hiding import Prelude hiding (mod) -- compiler and infrastructure +import Development.IDE.Core.Compile (setNonHomeFCHook) import Development.IDE.Core.PositionMapping import Development.IDE.Core.RuleTypes import Development.IDE.GHC.Compat @@ -306,7 +307,7 @@ atPoint IdeOptions{} (HAR _ (hf :: HieASTs a) rf _ (kind :: HieKind hietype)) (D -- the package(with version) this `ModuleName` belongs to. packageNameForImportStatement :: ModuleName -> IO T.Text packageNameForImportStatement mod = do - mpkg <- findImportedModule env mod :: IO (Maybe Module) + mpkg <- findImportedModule (setNonHomeFCHook env) mod :: IO (Maybe Module) let moduleName = printOutputable mod case mpkg >>= packageNameWithVersion of Nothing -> pure moduleName diff --git a/ghcide/src/Development/IDE/Types/Diagnostics.hs b/ghcide/src/Development/IDE/Types/Diagnostics.hs index cbd49a91f8..89e1f2d12f 100644 --- a/ghcide/src/Development/IDE/Types/Diagnostics.hs +++ b/ghcide/src/Development/IDE/Types/Diagnostics.hs @@ -37,7 +37,7 @@ import Control.Lens import qualified Data.Aeson as JSON import qualified Data.Aeson.Lens as JSON import Data.ByteString (ByteString) -import Data.List +import Data.Foldable import Data.Maybe as Maybe import qualified Data.Text as T import Development.IDE.GHC.Compat (GhcMessage, MsgEnvelope, @@ -146,7 +146,10 @@ attachReason Nothing = id attachReason (Just wr) = attachedReason .~ fmap JSON.toJSON (showReason wr) where showReason = \case - WarningWithFlag flag -> showFlag flag + WarningWithFlag flag -> Just $ catMaybes [showFlag flag] +#if MIN_VERSION_ghc(9,7,0) + WarningWithFlags flags -> Just $ catMaybes (fmap showFlag $ toList flags) +#endif _ -> Nothing showFlag :: WarningFlag -> Maybe T.Text diff --git a/ghcide/src/Development/IDE/Types/HscEnvEq.hs b/ghcide/src/Development/IDE/Types/HscEnvEq.hs index 10dc1b8f9f..1c2ed1732f 100644 --- a/ghcide/src/Development/IDE/Types/HscEnvEq.hs +++ b/ghcide/src/Development/IDE/Types/HscEnvEq.hs @@ -1,3 +1,4 @@ +{-# LANGUAGE CPP #-} module Development.IDE.Types.HscEnvEq ( HscEnvEq, hscEnv, newHscEnvEq, @@ -13,6 +14,8 @@ import Control.DeepSeq (force, rwhnf) import Control.Exception (evaluate, mask, throwIO) import Control.Monad.Extra (eitherM, join, mapMaybeM) import Data.Either (fromRight) +import Data.IORef +import qualified Data.Map as M import Data.Unique (Unique) import qualified Data.Unique as Unique import Development.IDE.GHC.Compat hiding (newUnique) @@ -21,7 +24,11 @@ import Development.IDE.GHC.Error (catchSrcErrors) import Development.IDE.GHC.Util (lookupPackageConfig) import Development.IDE.Graph.Classes import Development.IDE.Types.Exports (ExportsMap, createExportsMap) +import GHC.Driver.Env (hsc_all_home_unit_ids) +import Ide.PluginUtils (toAbsolute) import OpenTelemetry.Eventlog (withSpan) +import System.Directory (makeAbsolute) + -- | An 'HscEnv' with equality. Two values are considered equal -- if they are created with the same call to 'newHscEnvEq' or @@ -44,7 +51,32 @@ updateHscEnvEq oldHscEnvEq newHscEnv = do -- | Wrap an 'HscEnv' into an 'HscEnvEq'. newHscEnvEq :: HscEnv -> IO HscEnvEq -newHscEnvEq hscEnv = do +newHscEnvEq hscEnv' = do + + mod_cache <- newIORef emptyInstalledModuleEnv + file_cache <- newIORef M.empty + -- This finder cache is for things which are outside of things which are tracked + -- by HLS. For example, non-home modules, dependent object files etc +#if MIN_VERSION_ghc(9,11,0) + let hscEnv = hscEnv' + { hsc_FC = FinderCache + { flushFinderCaches = \_ -> error "GHC should never call flushFinderCaches outside the driver" + , addToFinderCache = \(GWIB im _) val -> do + if moduleUnit im `elem` hsc_all_home_unit_ids hscEnv' + then error "tried to add home module to FC" + else atomicModifyIORef' mod_cache $ \c -> (extendInstalledModuleEnv c im val, ()) + , lookupFinderCache = \(GWIB im _) -> do + if moduleUnit im `elem` hsc_all_home_unit_ids hscEnv' + then error ("tried to lookup home module from FC" ++ showSDocUnsafe (ppr (im, hsc_all_home_unit_ids hscEnv'))) + else lookupInstalledModuleEnv <$> readIORef mod_cache <*> pure im + , lookupFileCache = \fp -> error ("not used by HLS" ++ fp) + } + } + +#else + let hscEnv = hscEnv' +#endif + let dflags = hsc_dflags hscEnv envUnique <- Unique.newUnique diff --git a/haskell-language-server.cabal b/haskell-language-server.cabal index b440036c4e..38f30428be 100644 --- a/haskell-language-server.cabal +++ b/haskell-language-server.cabal @@ -147,7 +147,7 @@ library hls-cabal-fmt-plugin -- The `hls-cabal-plugin` is needed for tests, as we need to install notification handlers test-suite hls-cabal-fmt-plugin-tests import: defaults, pedantic, test-defaults, warnings - if !flag(cabalfmt) + if !flag(cabalfmt) || !flag(cabal) buildable: False type: exitcode-stdio-1.0 hs-source-dirs: plugins/hls-cabal-fmt-plugin/test @@ -174,7 +174,7 @@ flag cabalgild manual: True common cabalgild - if flag(cabalgild) + if flag(cabalgild) && impl(ghc < 9.11) build-depends: haskell-language-server:hls-cabal-gild-plugin cpp-options: -Dhls_cabalgild @@ -186,7 +186,7 @@ flag isolateCabalGildTests library hls-cabal-gild-plugin import: defaults, pedantic, warnings - if !flag(cabalgild) + if !flag(cabalgild) || impl(ghc > 9.11) buildable: False exposed-modules: Ide.Plugin.CabalGild hs-source-dirs: plugins/hls-cabal-gild-plugin/src @@ -203,7 +203,7 @@ library hls-cabal-gild-plugin -- The `hls-cabal-plugin` is needed for tests, as we need to install notification handlers test-suite hls-cabal-gild-plugin-tests import: defaults, pedantic, test-defaults, warnings - if !flag(cabalgild) + if !flag(cabalgild) || !flag(cabal) || impl(ghc > 9.11) buildable: False type: exitcode-stdio-1.0 hs-source-dirs: plugins/hls-cabal-gild-plugin/test @@ -348,7 +348,7 @@ library hls-class-plugin , deepseq , extra , ghc - , ghc-exactprint >= 1.5 && < 1.10.0.0 + , ghc-exactprint >= 1.5 && < 1.13.0.0 , ghcide == 2.9.0.1 , hls-graph , hls-plugin-api == 2.9.0.1 @@ -521,16 +521,16 @@ test-suite hls-eval-plugin-tests -- import lens plugin ----------------------------- +flag importLens + description: Enable importLens plugin + default: True + manual: False + common importLens if flag(importLens) build-depends: haskell-language-server:hls-explicit-imports-plugin cpp-options: -Dhls_importLens -flag importLens - description: Enable importLens plugin - default: True - manual: True - library hls-explicit-imports-plugin import: defaults, pedantic, warnings if !flag(importlens) @@ -580,13 +580,13 @@ flag rename manual: True common rename - if flag(rename) + if flag(rename) && impl(ghc < 9.11) build-depends: haskell-language-server:hls-rename-plugin cpp-options: -Dhls_rename library hls-rename-plugin import: defaults, pedantic, warnings - if !flag(rename) + if !flag(rename) || impl(ghc > 9.11) buildable: False exposed-modules: Ide.Plugin.Rename hs-source-dirs: plugins/hls-rename-plugin/src @@ -610,7 +610,7 @@ library hls-rename-plugin test-suite hls-rename-plugin-tests import: defaults, pedantic, test-defaults, warnings - if !flag(rename) + if !flag(rename) || impl(ghc > 9.11) buildable: False type: exitcode-stdio-1.0 hs-source-dirs: plugins/hls-rename-plugin/test @@ -710,7 +710,7 @@ common hlint library hls-hlint-plugin import: defaults, pedantic, warnings -- https://github.com/ndmitchell/hlint/pull/1594 - if !(flag(hlint) && impl(ghc < 9.10)) + if !(flag(hlint)) || impl(ghc > 9.10) buildable: False exposed-modules: Ide.Plugin.Hlint hs-source-dirs: plugins/hls-hlint-plugin/src @@ -753,7 +753,7 @@ library hls-hlint-plugin test-suite hls-hlint-plugin-tests import: defaults, pedantic, test-defaults, warnings - if !(flag(hlint) && impl(ghc < 9.10)) + if (!flag(hlint)) || impl(ghc > 9.10) buildable: False type: exitcode-stdio-1.0 hs-source-dirs: plugins/hls-hlint-plugin/test @@ -782,15 +782,13 @@ flag stan manual: True common stan - if flag(stan) + if flag(stan) && impl(ghc < 9.11) build-depends: haskell-language-server:hls-stan-plugin cpp-options: -Dhls_stan library hls-stan-plugin import: defaults, pedantic, warnings - if flag(stan) - buildable: True - else + if !flag(stan) || impl(ghc > 9.11) buildable: False exposed-modules: Ide.Plugin.Stan hs-source-dirs: plugins/hls-stan-plugin/src @@ -815,9 +813,7 @@ library hls-stan-plugin test-suite hls-stan-plugin-tests import: defaults, pedantic, test-defaults, warnings - if flag(stan) - buildable: True - else + if !flag(stan) || impl(ghc > 9.11) buildable: False type: exitcode-stdio-1.0 hs-source-dirs: plugins/hls-stan-plugin/test @@ -1212,13 +1208,13 @@ flag gadt manual: True common gadt - if flag(gadt) + if flag(gadt) && impl(ghc < 9.11) build-depends: haskell-language-server:hls-gadt-plugin cpp-options: -Dhls_gadt library hls-gadt-plugin import: defaults, pedantic, warnings - if !flag(gadt) + if !flag(gadt) || impl(ghc > 9.11) buildable: False exposed-modules: Ide.Plugin.GADT other-modules: Ide.Plugin.GHC @@ -1242,7 +1238,7 @@ library hls-gadt-plugin test-suite hls-gadt-plugin-tests import: defaults, pedantic, test-defaults, warnings - if !flag(gadt) + if !flag(gadt) || impl(ghc > 9.11) buildable: False type: exitcode-stdio-1.0 hs-source-dirs: plugins/hls-gadt-plugin/test @@ -1446,13 +1442,13 @@ flag fourmolu manual: True common fourmolu - if flag(fourmolu) + if flag(fourmolu) && impl(ghc < 9.11) build-depends: haskell-language-server:hls-fourmolu-plugin cpp-options: -Dhls_fourmolu library hls-fourmolu-plugin import: defaults, pedantic, warnings - if !flag(fourmolu) + if !flag(fourmolu) || impl(ghc > 9.11) buildable: False exposed-modules: Ide.Plugin.Fourmolu hs-source-dirs: plugins/hls-fourmolu-plugin/src @@ -1472,7 +1468,7 @@ library hls-fourmolu-plugin test-suite hls-fourmolu-plugin-tests import: defaults, pedantic, test-defaults, warnings - if !flag(fourmolu) + if !flag(fourmolu) || impl(ghc > 9.11) buildable: False type: exitcode-stdio-1.0 hs-source-dirs: plugins/hls-fourmolu-plugin/test @@ -1500,13 +1496,13 @@ flag ormolu manual: True common ormolu - if flag(ormolu) + if flag(ormolu) && impl(ghc < 9.11) build-depends: haskell-language-server:hls-ormolu-plugin cpp-options: -Dhls_ormolu library hls-ormolu-plugin import: defaults, pedantic, warnings - if !flag(ormolu) + if !flag(ormolu) || impl(ghc > 9.11) buildable: False exposed-modules: Ide.Plugin.Ormolu hs-source-dirs: plugins/hls-ormolu-plugin/src @@ -1526,7 +1522,7 @@ library hls-ormolu-plugin test-suite hls-ormolu-plugin-tests import: defaults, pedantic, test-defaults, warnings - if !flag(ormolu) + if !flag(ormolu) || impl(ghc > 9.11) buildable: False type: exitcode-stdio-1.0 hs-source-dirs: plugins/hls-ormolu-plugin/test @@ -1600,13 +1596,13 @@ flag refactor manual: True common refactor - if flag(refactor) + if flag(refactor) && impl(ghc < 9.11) build-depends: haskell-language-server:hls-refactor-plugin cpp-options: -Dhls_refactor library hls-refactor-plugin import: defaults, pedantic, warnings - if !flag(refactor) + if !flag(refactor) || impl(ghc > 9.11) buildable: False exposed-modules: Development.IDE.GHC.ExactPrint Development.IDE.GHC.Compat.ExactPrint @@ -1665,7 +1661,7 @@ library hls-refactor-plugin test-suite hls-refactor-plugin-tests import: defaults, pedantic, test-defaults, warnings - if !flag(refactor) + if !flag(refactor) || impl(ghc > 9.11) buildable: False type: exitcode-stdio-1.0 hs-source-dirs: plugins/hls-refactor-plugin/test @@ -2013,9 +2009,9 @@ test-suite func-test -- formatters if flag(floskell) && impl(ghc < 9.10) cpp-options: -Dhls_floskell - if flag(fourmolu) + if flag(fourmolu) && impl(ghc < 9.11) cpp-options: -Dhls_fourmolu - if flag(ormolu) + if flag(ormolu) && impl(ghc < 9.11) cpp-options: -Dhls_ormolu test-suite wrapper-test diff --git a/hie-compat/hie-compat.cabal b/hie-compat/hie-compat.cabal index bb96ab88fb..2b361df887 100644 --- a/hie-compat/hie-compat.cabal +++ b/hie-compat/hie-compat.cabal @@ -24,7 +24,7 @@ source-repository head library default-language: GHC2021 build-depends: - base < 4.21, array, bytestring, containers, directory, filepath, transformers + base < 4.22, array, bytestring, containers, directory, filepath, transformers build-depends: ghc >= 8.10, ghc-boot ghc-options: -Wall -Wno-name-shadowing diff --git a/hie-compat/src-ghc92/Compat/HieAst.hs b/hie-compat/src-ghc92/Compat/HieAst.hs index f72b1283de..dffa7bc78f 100644 --- a/hie-compat/src-ghc92/Compat/HieAst.hs +++ b/hie-compat/src-ghc92/Compat/HieAst.hs @@ -72,7 +72,7 @@ import qualified Data.Array as A import qualified Data.ByteString as BS import qualified Data.Map as M import qualified Data.Set as S -import Data.Data ( Data, Typeable ) +import Data.Data ( Data ) import Data.Void ( Void, absurd ) import Control.Monad ( forM_ ) import Control.Monad.Trans.State.Strict @@ -469,7 +469,7 @@ data PScoped a = PS (Maybe Span) Scope -- ^ use site of the pattern Scope -- ^ pattern to the right of a, not including a a - deriving (Typeable, Data) -- Pattern Scope + deriving (Data) -- Pattern Scope {- Note [TyVar Scopes] ~~~~~~~~~~~~~~~~~~~ diff --git a/hls-graph/src/Control/Concurrent/STM/Stats.hs b/hls-graph/src/Control/Concurrent/STM/Stats.hs index 3b7c28b013..a6e7d0459b 100644 --- a/hls-graph/src/Control/Concurrent/STM/Stats.hs +++ b/hls-graph/src/Control/Concurrent/STM/Stats.hs @@ -20,7 +20,6 @@ import Control.Monad import Data.IORef import qualified Data.Map.Strict as M import Data.Time (getCurrentTime) -import Data.Typeable (Typeable) import GHC.Conc (unsafeIOToSTM) import System.IO import System.IO.Unsafe @@ -151,7 +150,6 @@ trackSTMConf (TrackSTMConf {..}) name txm = do -- 'BlockedIndefinitelyOnNamedSTM', carrying the name of the transaction and -- thus giving more helpful error messages. newtype BlockedIndefinitelyOnNamedSTM = BlockedIndefinitelyOnNamedSTM String - deriving (Typeable) instance Show BlockedIndefinitelyOnNamedSTM where showsPrec _ (BlockedIndefinitelyOnNamedSTM name) = diff --git a/hls-graph/src/Development/IDE/Graph/Internal/Types.hs b/hls-graph/src/Development/IDE/Graph/Internal/Types.hs index c70cf6ff1c..34bed42391 100644 --- a/hls-graph/src/Development/IDE/Graph/Internal/Types.hs +++ b/hls-graph/src/Development/IDE/Graph/Internal/Types.hs @@ -227,7 +227,7 @@ data GraphException = forall e. Exception e => GraphException { stack :: [String], -- ^ The stack of keys that led to this exception inner :: e -- ^ The underlying exception } - deriving (Typeable, Exception) + deriving (Exception) instance Show GraphException where show GraphException{..} = unlines $ @@ -249,7 +249,7 @@ instance Show Stack where show (Stack kk _) = "Stack: " <> intercalate " -> " (map show kk) newtype StackException = StackException Stack - deriving (Typeable, Show) + deriving (Show) instance Exception StackException where fromException = fromGraphException diff --git a/hls-graph/test/Example.hs b/hls-graph/test/Example.hs index c6a74e90a6..c20ea79328 100644 --- a/hls-graph/test/Example.hs +++ b/hls-graph/test/Example.hs @@ -38,7 +38,7 @@ ruleBool = addRule $ \Rule _old _mode -> do data CondRule = CondRule - deriving (Eq, Generic, Hashable, NFData, Show, Typeable) + deriving (Eq, Generic, Hashable, NFData, Show) type instance RuleResult CondRule = Bool @@ -48,7 +48,7 @@ ruleCond mv = addRule $ \CondRule _old _mode -> do return $ RunResult ChangedRecomputeDiff "" r (return ()) data BranchedRule = BranchedRule - deriving (Eq, Generic, Hashable, NFData, Show, Typeable) + deriving (Eq, Generic, Hashable, NFData, Show) type instance RuleResult BranchedRule = Int ruleWithCond :: Rules () @@ -61,7 +61,7 @@ ruleWithCond = addRule $ \BranchedRule _old _mode -> do return $ RunResult ChangedRecomputeDiff "" (2 :: Int) (return ()) data SubBranchRule = SubBranchRule - deriving (Eq, Generic, Hashable, NFData, Show, Typeable) + deriving (Eq, Generic, Hashable, NFData, Show) type instance RuleResult SubBranchRule = Int ruleSubBranch :: C.MVar Int -> Rules () @@ -70,5 +70,5 @@ ruleSubBranch mv = addRule $ \SubBranchRule _old _mode -> do return $ RunResult ChangedRecomputeDiff "" r (return ()) data CountRule = CountRule - deriving (Eq, Generic, Hashable, NFData, Show, Typeable) + deriving (Eq, Generic, Hashable, NFData, Show) type instance RuleResult CountRule = Int diff --git a/hls-plugin-api/src/Ide/Types.hs b/hls-plugin-api/src/Ide/Types.hs index c84fe15345..3a06656a77 100644 --- a/hls-plugin-api/src/Ide/Types.hs +++ b/hls-plugin-api/src/Ide/Types.hs @@ -727,7 +727,7 @@ instance PluginRequestMethod Method_TextDocumentPrepareRename where combineResponses _ _ _ _ (x :| _) = x instance PluginRequestMethod Method_TextDocumentHover where - combineResponses _ _ _ _ (mapMaybe nullToMaybe . toList -> hs :: [Hover]) = + combineResponses _ _ _ _ (mapMaybe nullToMaybe . toList -> (hs :: [Hover])) = if null hs then InR Null else InL $ Hover (InL mcontent) r diff --git a/hls-test-utils/src/Test/Hls/Util.hs b/hls-test-utils/src/Test/Hls/Util.hs index d0621ebe3a..98c795f8e0 100644 --- a/hls-test-utils/src/Test/Hls/Util.hs +++ b/hls-test-utils/src/Test/Hls/Util.hs @@ -36,6 +36,7 @@ module Test.Hls.Util , inspectCodeAction , inspectCommand , inspectDiagnostic + , inspectDiagnosticAny , waitForDiagnosticsFrom , waitForDiagnosticsFromSource , waitForDiagnosticsFromSourceWithTimeout @@ -247,6 +248,10 @@ inspectDiagnostic :: [Diagnostic] -> [T.Text] -> IO Diagnostic inspectDiagnostic diags s = onMatch diags (\ca -> all (`T.isInfixOf` (ca ^. L.message)) s) err where err = "expected diagnostic matching '" ++ show s ++ "' but did not find one" +inspectDiagnosticAny :: [Diagnostic] -> [T.Text] -> IO Diagnostic +inspectDiagnosticAny diags s = onMatch diags (\ca -> any (`T.isInfixOf` (ca ^. L.message)) s) err + where err = "expected diagnostic matching one of'" ++ show s ++ "' but did not find one" + expectDiagnostic :: [Diagnostic] -> [T.Text] -> IO () expectDiagnostic diags s = void $ inspectDiagnostic diags s diff --git a/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal.hs b/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal.hs index 2abee54b5c..9a56467f3f 100644 --- a/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal.hs +++ b/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal.hs @@ -20,11 +20,11 @@ import qualified Data.HashMap.Strict as HashMap import qualified Data.List as List import qualified Data.List.NonEmpty as NE import qualified Data.Maybe as Maybe +import Data.Proxy import qualified Data.Text () import qualified Data.Text as T import qualified Data.Text.Encoding as Encoding import Data.Text.Utf16.Rope.Mixed as Rope -import Data.Typeable import Development.IDE as D import Development.IDE.Core.FileStore (getVersionedTextDoc) import Development.IDE.Core.PluginUtils @@ -249,10 +249,12 @@ cabalRules recorder plId = do let warningDiags = fmap (Diagnostics.warningDiagnostic file) pWarnings case pm of Left (_cabalVersion, pErrorNE) -> do - let regex :: T.Text + let regexUnknownCabalBefore310 :: T.Text -- We don't support the cabal version, this should not be an error, as the -- user did not do anything wrong. Instead we cast it to a warning - regex = "Unsupported cabal-version [0-9]+.[0-9]*" + regexUnknownCabalBefore310 = "Unsupported cabal-version [0-9]+.[0-9]*" + regexUnknownCabalVersion :: T.Text + regexUnknownCabalVersion = "Unsupported cabal format version in cabal-version field: [0-9]+.[0-9]+" unsupportedCabalHelpText = unlines [ "The used `cabal-version` is not fully supported by this `HLS` binary." , "Either the `cabal-version` is unknown, or too new for this executable." @@ -267,7 +269,10 @@ cabalRules recorder plId = do NE.toList $ NE.map ( \pe@(PError pos text) -> - if text =~ regex + if any (text =~) + [ regexUnknownCabalBefore310 + , regexUnknownCabalVersion + ] then Diagnostics.warningDiagnostic file (Syntax.PWarning Syntax.PWTOther pos $ unlines [ text @@ -437,14 +442,14 @@ newtype OfInterestCabalVar = OfInterestCabalVar (Var (HashMap NormalizedFilePath instance Shake.IsIdeGlobal OfInterestCabalVar data IsCabalFileOfInterest = IsCabalFileOfInterest - deriving (Eq, Show, Typeable, Generic) + deriving (Eq, Show, Generic) instance Hashable IsCabalFileOfInterest instance NFData IsCabalFileOfInterest type instance RuleResult IsCabalFileOfInterest = CabalFileOfInterestResult data CabalFileOfInterestResult = NotCabalFOI | IsCabalFOI FileOfInterestStatus - deriving (Eq, Show, Typeable, Generic) + deriving (Eq, Show, Generic) instance Hashable CabalFileOfInterestResult instance NFData CabalFileOfInterestResult diff --git a/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal/Completion/Types.hs b/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal/Completion/Types.hs index 2655fbcaa6..59796afe2b 100644 --- a/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal/Completion/Types.hs +++ b/plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal/Completion/Types.hs @@ -8,7 +8,6 @@ import Control.DeepSeq (NFData) import Control.Lens ((^.)) import Data.Hashable import qualified Data.Text as T -import Data.Typeable import Development.IDE as D import qualified Distribution.Fields as Syntax import qualified Distribution.PackageDescription as PD @@ -44,7 +43,7 @@ instance Pretty Log where type instance RuleResult ParseCabalFile = PD.GenericPackageDescription data ParseCabalFile = ParseCabalFile - deriving (Eq, Show, Typeable, Generic) + deriving (Eq, Show, Generic) instance Hashable ParseCabalFile @@ -53,7 +52,7 @@ instance NFData ParseCabalFile type instance RuleResult ParseCabalFields = [Syntax.Field Syntax.Position] data ParseCabalFields = ParseCabalFields - deriving (Eq, Show, Typeable, Generic) + deriving (Eq, Show, Generic) instance Hashable ParseCabalFields @@ -62,7 +61,7 @@ instance NFData ParseCabalFields type instance RuleResult ParseCabalCommonSections = [Syntax.Field Syntax.Position] data ParseCabalCommonSections = ParseCabalCommonSections - deriving (Eq, Show, Typeable, Generic) + deriving (Eq, Show, Generic) instance Hashable ParseCabalCommonSections diff --git a/plugins/hls-cabal-plugin/test/Main.hs b/plugins/hls-cabal-plugin/test/Main.hs index cec2d36a53..fce47c15c6 100644 --- a/plugins/hls-cabal-plugin/test/Main.hs +++ b/plugins/hls-cabal-plugin/test/Main.hs @@ -110,7 +110,7 @@ pluginTests = , runCabalTestCaseSession "Publishes Diagnostics on unsupported cabal version as Warning" "" $ do _ <- openDoc "unsupportedVersion.cabal" "cabal" diags <- cabalCaptureKick - unknownVersionDiag <- liftIO $ inspectDiagnostic diags ["Unsupported cabal-version 99999.0"] + unknownVersionDiag <- liftIO $ inspectDiagnosticAny diags ["Unsupported cabal-version 99999.0", "Unsupported cabal format version in cabal-version field: 99999.0"] liftIO $ do length diags @?= 1 unknownVersionDiag ^. L.range @?= Range (Position 0 0) (Position 1 0) diff --git a/plugins/hls-call-hierarchy-plugin/test/Main.hs b/plugins/hls-call-hierarchy-plugin/test/Main.hs index f356a0e278..31dad633e6 100644 --- a/plugins/hls-call-hierarchy-plugin/test/Main.hs +++ b/plugins/hls-call-hierarchy-plugin/test/Main.hs @@ -114,13 +114,13 @@ prepareCallHierarchyTests = [ testCase "1" $ do let contents = T.unlines ["{-# LANGUAGE TypeFamilies #-}", "data family A"] -- Since GHC 9.10 the range also includes the family name (and its parameters if any) - range = mkRange 1 0 1 (if ghcVersion == GHC910 then 13 else 11) + range = mkRange 1 0 1 (if ghcVersion >= GHC910 then 13 else 11) selRange = mkRange 1 12 1 13 expected = mkCallHierarchyItemT "A" SymbolKind_Function range selRange oneCaseWithCreate contents 1 12 expected , testCase "2" $ do let contents = T.unlines [ "{-# LANGUAGE TypeFamilies #-}" , "data family A a"] - range = mkRange 1 0 1 (if ghcVersion == GHC910 then 15 else 11) + range = mkRange 1 0 1 (if ghcVersion >= GHC910 then 15 else 11) selRange = mkRange 1 12 1 13 expected = mkCallHierarchyItemT "A" SymbolKind_Function range selRange oneCaseWithCreate contents 1 12 expected diff --git a/plugins/hls-change-type-signature-plugin/test/Main.hs b/plugins/hls-change-type-signature-plugin/test/Main.hs index 3a45058a57..57541b4736 100644 --- a/plugins/hls-change-type-signature-plugin/test/Main.hs +++ b/plugins/hls-change-type-signature-plugin/test/Main.hs @@ -39,7 +39,7 @@ test :: TestTree test = testGroup "changeTypeSignature" [ testRegexes , codeActionTest "TExpectedActual" 4 11 - , knownBrokenForGhcVersions [GHC94 .. GHC910] "Error Message in 9.2+ does not provide enough info" $ + , knownBrokenForGhcVersions [GHC94 .. GHC912] "Error Message in 9.2+ does not provide enough info" $ codeActionTest "TRigidType" 4 14 , codeActionTest "TRigidType2" 4 6 , codeActionTest "TLocalBinding" 7 22 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 11afcfd1c4..71deb9c1d8 100644 --- a/plugins/hls-class-plugin/src/Ide/Plugin/Class/ExactPrint.hs +++ b/plugins/hls-class-plugin/src/Ide/Plugin/Class/ExactPrint.hs @@ -30,7 +30,11 @@ makeEditText pm df AddMinimalMethodsParams{..} = do pm_parsed_source pm old = T.pack $ exactPrint ps +#if MIN_VERSION_ghc_exactprint(1,10,0) + ps' = addMethodDecls ps mDecls range withSig +#else (ps', _, _) = runTransform (addMethodDecls ps mDecls range withSig) +#endif new = T.pack $ exactPrint ps' pure (old, new) @@ -40,7 +44,9 @@ makeMethodDecl df (mName, sig) = do sig' <- eitherToMaybe $ parseDecl df (T.unpack sig) $ T.unpack sig pure (name, sig') -#if MIN_VERSION_ghc(9,5,0) +#if MIN_VERSION_ghc_exactprint(1,10,0) +addMethodDecls :: ParsedSource -> [(LHsDecl GhcPs, LHsDecl GhcPs)] -> Range -> Bool -> Located (HsModule GhcPs) +#elif MIN_VERSION_ghc(9,5,0) addMethodDecls :: ParsedSource -> [(LHsDecl GhcPs, LHsDecl GhcPs)] -> Range -> Bool -> TransformT Identity (Located (HsModule GhcPs)) #else addMethodDecls :: ParsedSource -> [(LHsDecl GhcPs, LHsDecl GhcPs)] -> Range -> Bool -> TransformT Identity (Located HsModule) @@ -50,12 +56,20 @@ addMethodDecls ps mDecls range withSig | otherwise = go (map fst mDecls) where go inserting = do +#if MIN_VERSION_ghc_exactprint(1,10,0) + let allDecls = hsDecls ps +#else allDecls <- hsDecls ps +#endif case break (inRange range . getLoc) allDecls of (before, L l inst : after) -> let instSpan = realSrcSpan $ getLoc l +#if MIN_VERSION_ghc(9,11,0) + instCol = srcSpanStartCol instSpan - 1 +#else instCol = srcSpanStartCol instSpan +#endif #if MIN_VERSION_ghc(9,9,0) instRow = srcSpanEndLine instSpan methodEpAnn = noAnnSrcSpanDP $ deltaPos 1 (instCol + defaultIndent) @@ -91,7 +105,17 @@ addMethodDecls ps mDecls range withSig addWhere :: HsDecl GhcPs -> HsDecl GhcPs addWhere instd@(InstD xInstD (ClsInstD ext decl@ClsInstDecl{..})) = case cid_ext of -#if MIN_VERSION_ghc(9,9,0) +#if MIN_VERSION_ghc(9,11,0) + (warnings, anns, key) + | EpTok _ <- acid_where anns -> instd + | otherwise -> + InstD xInstD (ClsInstD ext decl { + cid_ext = ( warnings + , anns { acid_where = EpTok d1 } + , key + ) + }) +#elif MIN_VERSION_ghc(9,9,0) (warnings, anns, key) | any (\(AddEpAnn kw _ )-> kw == AnnWhere) anns -> instd | otherwise -> 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 18c9dbae26..e66632c3c6 100644 --- a/plugins/hls-class-plugin/src/Ide/Plugin/Class/Types.hs +++ b/plugins/hls-class-plugin/src/Ide/Plugin/Class/Types.hs @@ -176,7 +176,11 @@ getInstanceBindLensRule recorder = do getBindSpanWithoutSig :: ClsInstDecl GhcRn -> [BindInfo] getBindSpanWithoutSig ClsInstDecl{..} = - let bindNames = mapMaybe go (bagToList cid_binds) + let bindNames = mapMaybe go $ +#if !MIN_VERSION_ghc(9,11,0) + bagToList +#endif + cid_binds go (L l bind) = case bind of FunBind{..} -- `Generated` tagged for Template Haskell, @@ -221,5 +225,10 @@ getInstanceBindTypeSigsRule recorder = do let name = idName id whenMaybe (isBindingName name) $ do env <- tcInitTidyEnv - let (_, ty) = tidyOpenType env (idType id) +#if MIN_VERSION_ghc(9,11,0) + let ty = +#else + let (_, ty) = +#endif + tidyOpenType env (idType id) pure $ InstanceBindTypeSig name ty diff --git a/plugins/hls-code-range-plugin/src/Ide/Plugin/CodeRange/Rules.hs b/plugins/hls-code-range-plugin/src/Ide/Plugin/CodeRange/Rules.hs index 2c0adc9ca5..86d5923011 100644 --- a/plugins/hls-code-range-plugin/src/Ide/Plugin/CodeRange/Rules.hs +++ b/plugins/hls-code-range-plugin/src/Ide/Plugin/CodeRange/Rules.hs @@ -29,7 +29,6 @@ import Control.Monad.Trans.Maybe (MaybeT (MaybeT), maybeToExceptT) import Control.Monad.Trans.Writer.CPS import Data.Coerce (coerce) -import Data.Data (Typeable) import Data.Foldable (traverse_) import Data.Function (on, (&)) import Data.Hashable @@ -158,7 +157,7 @@ simplify r = withChildrenSimplified = r { _codeRange_children = simplify <$> _codeRange_children r } data GetCodeRange = GetCodeRange - deriving (Eq, Show, Typeable, Generic) + deriving (Eq, Show, Generic) instance Hashable GetCodeRange instance NFData GetCodeRange 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 800980ae4a..b88d096f8e 100644 --- a/plugins/hls-eval-plugin/src/Ide/Plugin/Eval/CodeLens.hs +++ b/plugins/hls-eval-plugin/src/Ide/Plugin/Eval/CodeLens.hs @@ -40,7 +40,6 @@ import Data.String (IsString) import Data.Text (Text) import qualified Data.Text as T import qualified Data.Text.Utf16.Rope.Mixed as Rope -import Data.Typeable (Typeable) import Development.IDE.Core.FileStore (getUriContents) import Development.IDE.Core.Rules (IdeState, runAction) @@ -122,6 +121,10 @@ import qualified Language.LSP.Protocol.Lens as L import Language.LSP.Protocol.Message import Language.LSP.Protocol.Types import Language.LSP.Server +#if MIN_VERSION_ghc(9,11,0) +import GHC.Unit.Module.ModIface (IfaceTopEnv (..)) +#endif + {- | Code Lens provider NOTE: Invoked every time the document is modified, not just when the document is saved. @@ -240,17 +243,22 @@ initialiseSessionForEval needs_quickcheck st nfp = do -- However, the eval plugin (setContext specifically) requires the rdr_env -- for the current module - so get it from the Typechecked Module and add -- it back to the iface for the current module. - rdr_env <- tcg_rdr_env . tmrTypechecked <$> use_ TypeCheck nfp + tm <- tmrTypechecked <$> use_ TypeCheck nfp + let rdr_env = tcg_rdr_env tm let linkable_hsc = loadModulesHome (map (addRdrEnv . linkableHomeMod) linkables) deps_hsc addRdrEnv hmi | iface <- hm_iface hmi , ms_mod ms == mi_module iface +#if MIN_VERSION_ghc(9,11,0) + = hmi { hm_iface = set_mi_top_env (Just $ IfaceTopEnv (forceGlobalRdrEnv (globalRdrEnvLocal rdr_env)) (mkIfaceImports $ tcg_import_decls tm)) iface} +#else = hmi { hm_iface = iface { mi_globals = Just $! #if MIN_VERSION_ghc(9,8,0) forceGlobalRdrEnv #endif rdr_env }} +#endif | otherwise = hmi return (ms, linkable_hsc) @@ -271,6 +279,15 @@ initialiseSessionForEval needs_quickcheck st nfp = do getSession return env2 +#if MIN_VERSION_ghc(9,11,0) +mkIfaceImports :: [ImportUserSpec] -> [IfaceImport] +mkIfaceImports = map go + where + go (ImpUserSpec decl ImpUserAll) = IfaceImport decl ImpIfaceAll + go (ImpUserSpec decl (ImpUserExplicit env)) = IfaceImport decl (ImpIfaceExplicit (forceGlobalRdrEnv env)) + go (ImpUserSpec decl (ImpUserEverythingBut ns)) = IfaceImport decl (ImpIfaceEverythingBut ns) +#endif + addFinalReturn :: Text -> [TextEdit] -> [TextEdit] addFinalReturn mdlText edits | not (null edits) && not (T.null mdlText) && T.last mdlText /= '\n' = @@ -497,7 +514,7 @@ singleLine s = [T.pack s] errorLines :: String -> [Text] errorLines = dropWhileEnd T.null - . takeWhile (not . ("CallStack" `T.isPrefixOf`)) + . takeWhile (not . (\x -> "CallStack" `T.isPrefixOf` x || "HasCallStack" `T.isPrefixOf` x)) . T.lines . T.pack @@ -637,7 +654,6 @@ data GhciLikeCmdException = GhciLikeCmdNotImplemented { ghciCmdName :: Text , ghciCmdArg :: Text } - deriving (Typeable) instance Show GhciLikeCmdException where showsPrec _ GhciLikeCmdNotImplemented{..} = diff --git a/plugins/hls-eval-plugin/src/Ide/Plugin/Eval/Rules.hs b/plugins/hls-eval-plugin/src/Ide/Plugin/Eval/Rules.hs index 6990c4a6e5..3d896f1da1 100644 --- a/plugins/hls-eval-plugin/src/Ide/Plugin/Eval/Rules.hs +++ b/plugins/hls-eval-plugin/src/Ide/Plugin/Eval/Rules.hs @@ -65,7 +65,13 @@ unqueueForEvaluation ide nfp = do apiAnnComments' :: ParsedModule -> [SrcLoc.RealLocated EpaCommentTok] apiAnnComments' pm = do L span (EpaComment c _) <- getEpaComments $ pm_parsed_source pm - pure (L (anchor span) c) + pure (L ( +#if MIN_VERSION_ghc(9,11,0) + epaLocationRealSrcSpan +#else + anchor +#endif + span) c) where #if MIN_VERSION_ghc(9,5,0) getEpaComments :: Development.IDE.GHC.Compat.Located (HsModule GhcPs) -> [LEpaComment] diff --git a/plugins/hls-eval-plugin/src/Ide/Plugin/Eval/Types.hs b/plugins/hls-eval-plugin/src/Ide/Plugin/Eval/Types.hs index 43ea57c956..1753ab4e6c 100644 --- a/plugins/hls-eval-plugin/src/Ide/Plugin/Eval/Types.hs +++ b/plugins/hls-eval-plugin/src/Ide/Plugin/Eval/Types.hs @@ -157,14 +157,14 @@ data Test deriving (Eq, Show, Generic, FromJSON, ToJSON, NFData) data IsEvaluating = IsEvaluating - deriving (Eq, Show, Typeable, Generic) + deriving (Eq, Show, Generic) instance Hashable IsEvaluating instance NFData IsEvaluating type instance RuleResult IsEvaluating = Bool data GetEvalComments = GetEvalComments - deriving (Eq, Show, Typeable, Generic) + deriving (Eq, Show, Generic) instance Hashable GetEvalComments instance NFData GetEvalComments diff --git a/plugins/hls-eval-plugin/test/Main.hs b/plugins/hls-eval-plugin/test/Main.hs index f2adf6cb85..2e4ae3b0f4 100644 --- a/plugins/hls-eval-plugin/test/Main.hs +++ b/plugins/hls-eval-plugin/test/Main.hs @@ -75,7 +75,7 @@ tests = else "-- No instance for (Num String) arising from a use of `+'\n-- In the expression: \"a\" + \"bc\"\n-- In an equation for `res': res = \"a\" + \"bc\"" - evalInFile "T8.hs" "-- >>> \"" "-- lexical error in string/character literal at end of input" + evalInFile "T8.hs" "-- >>> \"" (if ghcVersion >= GHC912 then "-- lexical error at end of input" else "-- lexical error in string/character literal at end of input") evalInFile "T8.hs" "-- >>> 3 `div` 0" "-- divide by zero" -- The default for marking exceptions is False , goldenWithEval "Applies file LANGUAGE extensions" "T9" "hs" , goldenWithEval "Evaluate a type with :kind!" "T10" "hs" @@ -126,9 +126,10 @@ tests = , goldenWithEval "The default language extensions for the eval plugin are the same as those for ghci" "TSameDefaultLanguageExtensionsAsGhci" "hs" , goldenWithEval "IO expressions are supported, stdout/stderr output is ignored" "TIO" "hs" , goldenWithEvalAndFs "Property checking" cabalProjectFS "TProperty" "hs" - , knownBrokenInEnv [HostOS Windows] "The output has path separators in it, which on Windows look different. Just skip it there" $ + , knownBrokenInWindowsBeforeGHC912 "The output has path separators in it, which on Windows look different. Just skip it there" $ goldenWithEvalAndFs' "Property checking with exception" cabalProjectFS "TPropertyError" "hs" $ case ghcVersion of + GHC912 -> "ghc912.expected" GHC910 -> "ghc910.expected" GHC98 -> "ghc98.expected" GHC96 -> "ghc96.expected" @@ -209,6 +210,12 @@ tests = let ifaceKeys = filter ("GetModIface" `T.isPrefixOf`) keys liftIO $ ifaceKeys @?= [] ] + where + knownBrokenInWindowsBeforeGHC912 msg = + foldl (.) id + [ knownBrokenInSpecificEnv [GhcVer ghcVer, HostOS Windows] msg + | ghcVer <- [GHC94 .. GHC910] + ] goldenWithEval :: TestName -> FilePath -> FilePath -> TestTree goldenWithEval title path ext = diff --git a/plugins/hls-eval-plugin/test/testdata/TPropertyError.ghc912.expected.hs b/plugins/hls-eval-plugin/test/testdata/TPropertyError.ghc912.expected.hs new file mode 100644 index 0000000000..46359c86ab --- /dev/null +++ b/plugins/hls-eval-plugin/test/testdata/TPropertyError.ghc912.expected.hs @@ -0,0 +1,6 @@ +-- Support for property checking +module TProperty where + +-- prop> \(l::[Bool]) -> head l +-- *** Failed! Exception: 'Prelude.head: empty list' (after 1 test): +-- [] diff --git a/plugins/hls-explicit-fixity-plugin/src/Ide/Plugin/ExplicitFixity.hs b/plugins/hls-explicit-fixity-plugin/src/Ide/Plugin/ExplicitFixity.hs index 7ed9a67e97..92bc37f743 100644 --- a/plugins/hls-explicit-fixity-plugin/src/Ide/Plugin/ExplicitFixity.hs +++ b/plugins/hls-explicit-fixity-plugin/src/Ide/Plugin/ExplicitFixity.hs @@ -1,3 +1,4 @@ +{-# LANGUAGE CPP #-} {-# LANGUAGE DataKinds #-} {-# LANGUAGE LambdaCase #-} {-# LANGUAGE OverloadedStrings #-} @@ -60,7 +61,11 @@ hover state _ (HoverParams (TextDocumentIdentifier uri) pos _) = do in Just $ Hover (InL (mkPlainText contents')) Nothing fixityText :: (Name, Fixity) -> T.Text +#if MIN_VERSION_GLASGOW_HASKELL(9,12,0,0) + fixityText (name, Fixity precedence direction) = +#else fixityText (name, Fixity _ precedence direction) = +#endif printOutputable direction <> " " <> printOutputable precedence <> " `" <> printOutputable name <> "`" newtype FixityMap = FixityMap (M.Map Name Fixity) 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 611c02fc78..5b379c9b9e 100644 --- a/plugins/hls-explicit-imports-plugin/src/Ide/Plugin/ExplicitImports.hs +++ b/plugins/hls-explicit-imports-plugin/src/Ide/Plugin/ExplicitImports.hs @@ -86,7 +86,7 @@ instance Pretty Log where descriptor :: Recorder (WithPriority Log) -> PluginId -> PluginDescriptor IdeState descriptor recorder = -- (almost) no one wants to see an explicit import list for Prelude - descriptorForModules recorder (/= moduleName pRELUDE) + descriptorForModules recorder (/= pRELUDE_NAME) descriptorForModules :: Recorder (WithPriority Log) @@ -403,7 +403,7 @@ minimalImportsRule recorder modFilter = defineNoDiagnostics (cmapWithPrio LogSha -- for every minimal imports | (location, origImport, minImport@(ImportDecl{ideclName = L _ mn})) <- locationImportWithMinimal -- (almost) no one wants to see an refine import list for Prelude - , mn /= moduleName pRELUDE + , mn /= pRELUDE_NAME -- we check for the inner imports , Just innerImports <- [Map.lookup mn import2Map] -- and only get those symbols used diff --git a/plugins/hls-explicit-record-fields-plugin/src/Ide/Plugin/ExplicitFields.hs b/plugins/hls-explicit-record-fields-plugin/src/Ide/Plugin/ExplicitFields.hs index 137965ed92..9279e45fb1 100644 --- a/plugins/hls-explicit-record-fields-plugin/src/Ide/Plugin/ExplicitFields.hs +++ b/plugins/hls-explicit-record-fields-plugin/src/Ide/Plugin/ExplicitFields.hs @@ -506,7 +506,11 @@ showRecordPatFlds (ConPat _ _ args) = do where processRecCon (RecCon flds) = Just $ processRecordFlds flds processRecCon _ = Nothing +#if __GLASGOW_HASKELL__ < 911 getOccName (FieldOcc x _) = Just $ getName x +#else + getOccName (FieldOcc _ x) = Just $ getName (unLoc x) +#endif getOccName _ = Nothing getFieldName = getOccName . unLoc . hfbLHS . unLoc showRecordPatFlds _ = Nothing @@ -589,7 +593,11 @@ getRecCons expr@(unLoc -> app@(HsApp _ _ _)) = getExprFields :: HsExpr GhcTc -> [FieldLabel] getExprFields (XExpr (ConLikeTc (conLikeFieldLabels -> fls) _ _)) = fls +#if __GLASGOW_HASKELL__ >= 911 + getExprFields (XExpr (WrapExpr _ expr)) = getExprFields expr +#else getExprFields (XExpr (WrapExpr (HsWrap _ expr))) = getExprFields expr +#endif getExprFields _ = [] getRecCons _ = ([], False) diff --git a/plugins/hls-hlint-plugin/src/Ide/Plugin/Hlint.hs b/plugins/hls-hlint-plugin/src/Ide/Plugin/Hlint.hs index 14c43f8db8..9621f894e3 100644 --- a/plugins/hls-hlint-plugin/src/Ide/Plugin/Hlint.hs +++ b/plugins/hls-hlint-plugin/src/Ide/Plugin/Hlint.hs @@ -178,7 +178,7 @@ descriptor recorder plId = -- This rule only exists for generating file diagnostics -- so the RuleResult is empty data GetHlintDiagnostics = GetHlintDiagnostics - deriving (Eq, Show, Typeable, Generic) + deriving (Eq, Show, Generic) instance Hashable GetHlintDiagnostics instance NFData GetHlintDiagnostics @@ -331,7 +331,7 @@ getExtensions nfp = do -- --------------------------------------------------------------------- data GetHlintSettings = GetHlintSettings - deriving (Eq, Show, Typeable, Generic) + deriving (Eq, Show, Generic) instance Hashable GetHlintSettings instance NFData GetHlintSettings instance NFData Hint where rnf = rwhnf diff --git a/plugins/hls-overloaded-record-dot-plugin/src/Ide/Plugin/OverloadedRecordDot.hs b/plugins/hls-overloaded-record-dot-plugin/src/Ide/Plugin/OverloadedRecordDot.hs index c37bba6359..8ead286b67 100644 --- a/plugins/hls-overloaded-record-dot-plugin/src/Ide/Plugin/OverloadedRecordDot.hs +++ b/plugins/hls-overloaded-record-dot-plugin/src/Ide/Plugin/OverloadedRecordDot.hs @@ -291,12 +291,20 @@ getRecSels (unLoc -> XExpr (HsExpanded a _)) = (collectRecordSelectors a, True) #endif -- applied record selection: "selector record" or "selector (record)" or -- "selector selector2.record2" +#if __GLASGOW_HASKELL__ >= 911 +getRecSels e@(unLoc -> HsApp _ se@(unLoc -> XExpr (HsRecSelRn _)) re) = +#else getRecSels e@(unLoc -> HsApp _ se@(unLoc -> HsRecSel _ _) re) = +#endif ( [ RecordSelectorExpr (realSrcSpanToRange realSpan') se re | RealSrcSpan realSpan' _ <- [ getLoc e ] ], False ) -- Record selection where the field is being applied with the "$" operator: -- "selector $ record" +#if __GLASGOW_HASKELL__ >= 911 +getRecSels e@(unLoc -> OpApp _ se@(unLoc -> XExpr (HsRecSelRn _)) +#else getRecSels e@(unLoc -> OpApp _ se@(unLoc -> HsRecSel _ _) +#endif (unLoc -> HsVar _ (unLoc -> d)) re) | d == dollarName = ( [ RecordSelectorExpr (realSrcSpanToRange realSpan') se re | RealSrcSpan realSpan' _ <- [ getLoc e ] ], False ) diff --git a/plugins/hls-pragmas-plugin/src/Ide/Plugin/Pragmas.hs b/plugins/hls-pragmas-plugin/src/Ide/Plugin/Pragmas.hs index bd265b74db..23bfd727cf 100644 --- a/plugins/hls-pragmas-plugin/src/Ide/Plugin/Pragmas.hs +++ b/plugins/hls-pragmas-plugin/src/Ide/Plugin/Pragmas.hs @@ -19,6 +19,7 @@ import Control.Lens hiding (List) import Control.Monad.IO.Class (MonadIO (liftIO)) import qualified Data.Aeson as JSON import Data.Char (isAlphaNum) +import qualified Data.Foldable as Foldable import Data.List.Extra (nubOrdOn) import qualified Data.Map as M import Data.Maybe (mapMaybe) @@ -122,10 +123,13 @@ suggest dflags diag = suggestDisableWarning :: Diagnostic -> [PragmaEdit] suggestDisableWarning diagnostic - | Just (Just (JSON.String attachedReason)) <- diagnostic ^? attachedReason - , Just w <- T.stripPrefix "-W" attachedReason - , w `notElem` warningBlacklist = - pure ("Disable \"" <> w <> "\" warnings", OptGHC w) + | Just (Just (JSON.Array attachedReasons)) <- diagnostic ^? attachedReason + = + [ ("Disable \"" <> w <> "\" warnings", OptGHC w) + | JSON.String attachedReason <- Foldable.toList attachedReasons + , Just w <- [T.stripPrefix "-W" attachedReason] + , w `notElem` warningBlacklist + ] | otherwise = [] warningBlacklist :: [T.Text] diff --git a/plugins/hls-pragmas-plugin/test/Main.hs b/plugins/hls-pragmas-plugin/test/Main.hs index 9b1eb10181..1e38e439ab 100644 --- a/plugins/hls-pragmas-plugin/test/Main.hs +++ b/plugins/hls-pragmas-plugin/test/Main.hs @@ -73,10 +73,10 @@ codeActionTests = , codeActionTestWithPragmasSuggest "adds TypeApplications pragma" "TypeApplications" [("Add \"TypeApplications\"", "Contains TypeApplications code action")] , codeActionTestWithPragmasSuggest "after shebang" "AfterShebang" [("Add \"NamedFieldPuns\"", "Contains NamedFieldPuns code action")] , codeActionTestWithPragmasSuggest "append to existing pragmas" "AppendToExisting" [("Add \"NamedFieldPuns\"", "Contains NamedFieldPuns code action")] - , codeActionTestWithPragmasSuggest "before doc comments" "BeforeDocComment" [("Add \"NamedFieldPuns\"", "Contains NamedFieldPuns code action")] + , codeActionTestWithPragmasSuggest "before doc comments NamedFieldPuns" "BeforeDocComment" [("Add \"NamedFieldPuns\"", "Contains NamedFieldPuns code action")] , codeActionTestWithPragmasSuggest "adds TypeSynonymInstances pragma" "NeedsPragmas" [("Add \"TypeSynonymInstances\"", "Contains TypeSynonymInstances code action"), ("Add \"FlexibleInstances\"", "Contains FlexibleInstances code action")] - , codeActionTestWithDisableWarning "before doc comments" "MissingSignatures" [("Disable \"missing-signatures\" warnings", "Contains missing-signatures code action")] - , codeActionTestWithDisableWarning "before doc comments" "UnusedImports" [("Disable \"unused-imports\" warnings", "Contains unused-imports code action")] + , codeActionTestWithDisableWarning "before doc comments missing-signatures" "MissingSignatures" [("Disable \"missing-signatures\" warnings", "Contains missing-signatures code action")] + , codeActionTestWithDisableWarning "before doc comments unused-imports" "UnusedImports" [("Disable \"unused-imports\" warnings", "Contains unused-imports code action")] ] codeActionTestWithPragmasSuggest :: String -> FilePath -> [(T.Text, String)] -> TestTree 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 6a157c4948..c610225ef5 100644 --- a/plugins/hls-refactor-plugin/src/Development/IDE/GHC/Dump.hs +++ b/plugins/hls-refactor-plugin/src/Development/IDE/GHC/Dump.hs @@ -42,9 +42,13 @@ showAstDataHtml a0 = html $ generic `ext1Q` list `extQ` string `extQ` fastString `extQ` srcSpan `extQ` realSrcSpan +#if !MIN_VERSION_ghc(9,11,0) `extQ` annotation +#endif `extQ` annotationModule +#if !MIN_VERSION_ghc(9,11,0) `extQ` annotationAddEpAnn +#endif `extQ` annotationGrhsAnn `extQ` annotationEpAnnHsCase `extQ` annotationEpAnnHsLet @@ -53,7 +57,9 @@ showAstDataHtml a0 = html $ `extQ` annotationAnnParen `extQ` annotationTrailingAnn `extQ` annotationEpaLocation +#if !MIN_VERSION_ghc(9,11,0) `extQ` addEpAnn +#endif `extQ` lit `extQ` litr `extQ` litt `extQ` sourceText `extQ` deltaPos @@ -135,7 +141,11 @@ showAstDataHtml a0 = html $ #else epaAnchor (EpaSpan r) = text "EpaSpan" <+> realSrcSpan r #endif +#if MIN_VERSION_ghc(9,11,0) + epaAnchor (EpaDelta s d cs) = text "EpaDelta" <+> srcSpan s <+> deltaPos d <+> showAstDataHtml' cs +#else epaAnchor (EpaDelta d cs) = text "EpaDelta" <+> deltaPos d <+> showAstDataHtml' cs +#endif #if !MIN_VERSION_ghc(9,9,0) anchorOp :: AnchorOperation -> SDoc @@ -169,8 +179,10 @@ showAstDataHtml a0 = html $ -- TODO: show annotations here (text "") +#if !MIN_VERSION_ghc(9,11,0) addEpAnn :: AddEpAnn -> SDoc addEpAnn (AddEpAnn a s) = text "AddEpAnn" <+> ppr a <+> epaAnchor s +#endif var :: Var -> SDoc var v = braces $ text "Var:" <+> ppr v @@ -208,14 +220,18 @@ showAstDataHtml a0 = html $ -- ------------------------- +#if !MIN_VERSION_ghc(9,11,0) annotation :: EpAnn [AddEpAnn] -> SDoc annotation = annotation' (text "EpAnn [AddEpAnn]") +#endif annotationModule :: EpAnn AnnsModule -> SDoc annotationModule = annotation' (text "EpAnn AnnsModule") +#if !MIN_VERSION_ghc(9,11,0) annotationAddEpAnn :: EpAnn AddEpAnn -> SDoc annotationAddEpAnn = annotation' (text "EpAnn AddEpAnn") +#endif annotationGrhsAnn :: EpAnn GrhsAnn -> SDoc annotationGrhsAnn = annotation' (text "EpAnn GrhsAnn") @@ -231,7 +247,11 @@ showAstDataHtml a0 = html $ annotationEpAnnHsLet = annotation' (text "EpAnn AnnsLet") #endif +#if MIN_VERSION_ghc(9,11,0) + annotationAnnList :: EpAnn (AnnList ()) -> SDoc +#else annotationAnnList :: EpAnn AnnList -> SDoc +#endif annotationAnnList = annotation' (text "EpAnn AnnList") annotationEpAnnImportDecl :: EpAnn EpAnnImportDecl -> SDoc @@ -256,7 +276,11 @@ showAstDataHtml a0 = html $ srcSpanAnnA :: EpAnn AnnListItem -> SDoc srcSpanAnnA = locatedAnn'' (text "SrcSpanAnnA") +#if MIN_VERSION_ghc(9,11,0) + srcSpanAnnL :: EpAnn (AnnList ()) -> SDoc +#else srcSpanAnnL :: EpAnn AnnList -> SDoc +#endif srcSpanAnnL = locatedAnn'' (text "SrcSpanAnnL") srcSpanAnnP :: EpAnn AnnPragma -> SDoc diff --git a/plugins/hls-refactor-plugin/src/Development/IDE/GHC/ExactPrint.hs b/plugins/hls-refactor-plugin/src/Development/IDE/GHC/ExactPrint.hs index 38080ca4e5..e3c9aae828 100644 --- a/plugins/hls-refactor-plugin/src/Development/IDE/GHC/ExactPrint.hs +++ b/plugins/hls-refactor-plugin/src/Development/IDE/GHC/ExactPrint.hs @@ -90,7 +90,7 @@ import GHC (DeltaPos (..), #if !MIN_VERSION_ghc(9,9,0) import Data.Default (Default) -import GHC (Anchor (..), +import GHC ( Anchor (..), AnchorOperation, EpAnn (..), NameAdornment (NameParens), @@ -108,7 +108,10 @@ import GHC.Types.SrcLoc (generatedSrcSpan) #endif #if MIN_VERSION_ghc(9,9,0) -import GHC (Anchor, +import GHC ( +#if !MIN_VERSION_ghc(9,11,0) + Anchor, +#endif AnnContext (..), EpAnn (..), EpaLocation, @@ -137,7 +140,7 @@ instance Pretty Log where LogShake shakeLog -> pretty shakeLog data GetAnnotatedParsedSource = GetAnnotatedParsedSource - deriving (Eq, Show, Typeable, GHC.Generic) + deriving (Eq, Show, GHC.Generic) instance Hashable GetAnnotatedParsedSource instance NFData GetAnnotatedParsedSource @@ -578,9 +581,17 @@ modifyDeclsT' :: (HasDecls t, HasTransform m) => ([LHsDecl GhcPs] -> m ([LHsDecl GhcPs], r)) -> t -> m (t, r) modifyDeclsT' action t = do +#if MIN_VERSION_ghc_exactprint(1,10,0) + decls <- pure $ hsDecls t +#else decls <- liftT $ hsDecls t +#endif (decls', r) <- action decls +#if MIN_VERSION_ghc_exactprint(1,10,0) + t' <- pure $ replaceDecls t decls' +#else t' <- liftT $ replaceDecls t decls' +#endif pure (t', r) -- | Modify each LMatch in a MatchGroup diff --git a/plugins/hls-refactor-plugin/src/Development/IDE/Plugin/CodeAction/RuleTypes.hs b/plugins/hls-refactor-plugin/src/Development/IDE/Plugin/CodeAction/RuleTypes.hs index c338903d35..69f3332dc0 100644 --- a/plugins/hls-refactor-plugin/src/Development/IDE/Plugin/CodeAction/RuleTypes.hs +++ b/plugins/hls-refactor-plugin/src/Development/IDE/Plugin/CodeAction/RuleTypes.hs @@ -5,7 +5,6 @@ module Development.IDE.Plugin.CodeAction.RuleTypes import Control.DeepSeq (NFData) import Data.Hashable (Hashable) -import Data.Typeable (Typeable) import Development.IDE.Graph (RuleResult) import Development.IDE.Types.Exports import Development.IDE.Types.HscEnvEq (HscEnvEq) @@ -15,7 +14,7 @@ import GHC.Generics (Generic) type instance RuleResult PackageExports = ExportsMap newtype PackageExports = PackageExports HscEnvEq - deriving (Eq, Show, Typeable, Generic) + deriving (Eq, Show, Generic) instance Hashable PackageExports instance NFData PackageExports diff --git a/plugins/hls-retrie-plugin/src/Ide/Plugin/Retrie.hs b/plugins/hls-retrie-plugin/src/Ide/Plugin/Retrie.hs index e65eafa52b..fe72d945f4 100644 --- a/plugins/hls-retrie-plugin/src/Ide/Plugin/Retrie.hs +++ b/plugins/hls-retrie-plugin/src/Ide/Plugin/Retrie.hs @@ -502,7 +502,7 @@ data CallRetrieError | NoParse NormalizedFilePath | GHCParseError NormalizedFilePath String | NoTypeCheck NormalizedFilePath - deriving (Eq, Typeable) + deriving (Eq) instance Show CallRetrieError where show (CallRetrieInternalError msg f) = msg <> " - " <> fromNormalizedFilePath f diff --git a/plugins/hls-semantic-tokens-plugin/src/Ide/Plugin/SemanticTokens/Types.hs b/plugins/hls-semantic-tokens-plugin/src/Ide/Plugin/SemanticTokens/Types.hs index cda4fda6e6..7f445bf7ac 100644 --- a/plugins/hls-semantic-tokens-plugin/src/Ide/Plugin/SemanticTokens/Types.hs +++ b/plugins/hls-semantic-tokens-plugin/src/Ide/Plugin/SemanticTokens/Types.hs @@ -10,7 +10,6 @@ module Ide.Plugin.SemanticTokens.Types where import Control.DeepSeq (NFData (rnf), rwhnf) import qualified Data.Array as A import Data.Default (Default (def)) -import Data.Generics (Typeable) import Development.IDE (Pretty (pretty), RuleResult) import qualified Development.IDE.Core.Shake as Shake import Development.IDE.GHC.Compat hiding (loc) @@ -108,7 +107,7 @@ instance Show Loc where show (Loc line startChar len) = show line <> ":" <> show startChar <> "-" <> show (startChar + len) data GetSemanticTokens = GetSemanticTokens - deriving (Eq, Show, Typeable, Generic) + deriving (Eq, Show, Generic) instance Hashable GetSemanticTokens diff --git a/plugins/hls-semantic-tokens-plugin/test/SemanticTokensTest.hs b/plugins/hls-semantic-tokens-plugin/test/SemanticTokensTest.hs index eacd47e2d2..a0d1648fb3 100644 --- a/plugins/hls-semantic-tokens-plugin/test/SemanticTokensTest.hs +++ b/plugins/hls-semantic-tokens-plugin/test/SemanticTokensTest.hs @@ -10,8 +10,7 @@ import Data.Functor (void) import qualified Data.List as T import Data.Map.Strict as Map hiding (map) import Data.String (fromString) -import Data.Text hiding (length, map, - unlines) +import Data.Text (Text) import qualified Data.Text as Text import qualified Data.Text.Utf16.Rope.Mixed as Rope import Data.Version (Version (..)) diff --git a/plugins/hls-splice-plugin/src/Ide/Plugin/Splice.hs b/plugins/hls-splice-plugin/src/Ide/Plugin/Splice.hs index 43bdf5decb..8955b76e3c 100644 --- a/plugins/hls-splice-plugin/src/Ide/Plugin/Splice.hs +++ b/plugins/hls-splice-plugin/src/Ide/Plugin/Splice.hs @@ -466,7 +466,7 @@ unRenamedE dflags expr = do data SearchResult r = Continue | Stop | Here r - deriving (Read, Show, Eq, Ord, Data, Typeable) + deriving (Read, Show, Eq, Ord, Data) fromSearchResult :: SearchResult a -> Maybe a fromSearchResult (Here r) = Just r diff --git a/shake-bench/shake-bench.cabal b/shake-bench/shake-bench.cabal index eccd84edeb..c381089aba 100644 --- a/shake-bench/shake-bench.cabal +++ b/shake-bench/shake-bench.cabal @@ -16,6 +16,8 @@ source-repository head location: https://github.com/haskell/haskell-language-server.git library + if impl(ghc > 9.11) + buildable: False exposed-modules: Development.Benchmark.Rules hs-source-dirs: src build-depends: diff --git a/shake-bench/src/Development/Benchmark/Rules.hs b/shake-bench/src/Development/Benchmark/Rules.hs index 81510b3101..8ba2b3f0df 100644 --- a/shake-bench/src/Development/Benchmark/Rules.hs +++ b/shake-bench/src/Development/Benchmark/Rules.hs @@ -131,7 +131,7 @@ type RuleResultForExample e = , IsExample e) data Configuration = Configuration {confName :: String, confValue :: ByteString} - deriving (Binary, Eq, Generic, Hashable, NFData, Show, Typeable) + deriving (Binary, Eq, Generic, Hashable, NFData, Show) type instance RuleResult GetConfigurations = [Configuration] -- | Knowledge needed to run an example diff --git a/test/functional/Config.hs b/test/functional/Config.hs index 1f91ec4466..874792784f 100644 --- a/test/functional/Config.hs +++ b/test/functional/Config.hs @@ -8,7 +8,6 @@ import Control.Monad import Data.Hashable import qualified Data.HashMap.Strict as HM import qualified Data.Map as Map -import Data.Typeable (Typeable) import Development.IDE (RuleResult, action, define, getFilesOfInterestUntracked, getPluginConfigAction, ideErrorText, @@ -102,7 +101,7 @@ genericConfigTests = testGroup "generic plugin config" data GetTestDiagnostics = GetTestDiagnostics - deriving (Eq, Show, Typeable, Generic) + deriving (Eq, Show, Generic) instance Hashable GetTestDiagnostics instance NFData GetTestDiagnostics type instance RuleResult GetTestDiagnostics = () diff --git a/test/testdata/schema/ghc912/default-config.golden.json b/test/testdata/schema/ghc912/default-config.golden.json new file mode 100644 index 0000000000..cef104bd29 --- /dev/null +++ b/test/testdata/schema/ghc912/default-config.golden.json @@ -0,0 +1,110 @@ +{ + "cabalFormattingProvider": "cabal-gild", + "checkParents": "CheckOnSave", + "checkProject": true, + "formattingProvider": "ormolu", + "maxCompletions": 40, + "plugin": { + "alternateNumberFormat": { + "globalOn": true + }, + "cabal": { + "codeActionsOn": true, + "completionOn": true, + "diagnosticsOn": true, + "hoverOn": true, + "symbolsOn": true + }, + "cabal-fmt": { + "config": { + "path": "cabal-fmt" + } + }, + "cabalHaskellIntegration": { + "globalOn": true + }, + "callHierarchy": { + "globalOn": true + }, + "changeTypeSignature": { + "globalOn": true + }, + "class": { + "codeActionsOn": true, + "codeLensOn": true + }, + "eval": { + "config": { + "diff": true, + "exception": false + }, + "globalOn": true + }, + "explicit-fields": { + "codeActionsOn": true, + "inlayHintsOn": true + }, + "explicit-fixity": { + "globalOn": true + }, + "ghcide-completions": { + "config": { + "autoExtendOn": true, + "snippetsOn": true + }, + "globalOn": true + }, + "ghcide-hover-and-symbols": { + "hoverOn": true, + "symbolsOn": true + }, + "ghcide-type-lenses": { + "config": { + "mode": "always" + }, + "globalOn": true + }, + "importLens": { + "codeActionsOn": true, + "codeLensOn": true, + "inlayHintsOn": true + }, + "moduleName": { + "globalOn": true + }, + "overloaded-record-dot": { + "globalOn": true + }, + "pragmas-completion": { + "globalOn": true + }, + "pragmas-disable": { + "globalOn": true + }, + "pragmas-suggest": { + "globalOn": true + }, + "qualifyImportedNames": { + "globalOn": true + }, + "semanticTokens": { + "config": { + "classMethodToken": "method", + "classToken": "class", + "dataConstructorToken": "enumMember", + "functionToken": "function", + "moduleToken": "namespace", + "operatorToken": "operator", + "patternSynonymToken": "macro", + "recordFieldToken": "property", + "typeConstructorToken": "enum", + "typeFamilyToken": "interface", + "typeSynonymToken": "type", + "typeVariableToken": "typeParameter", + "variableToken": "variable" + }, + "globalOn": false + } + }, + "sessionLoading": "singleComponent" +} diff --git a/test/testdata/schema/ghc912/vscode-extension-schema.golden.json b/test/testdata/schema/ghc912/vscode-extension-schema.golden.json new file mode 100644 index 0000000000..20f2476400 --- /dev/null +++ b/test/testdata/schema/ghc912/vscode-extension-schema.golden.json @@ -0,0 +1,950 @@ +{ + "haskell.plugin.alternateNumberFormat.globalOn": { + "default": true, + "description": "Enables alternateNumberFormat plugin", + "scope": "resource", + "type": "boolean" + }, + "haskell.plugin.cabal-fmt.config.path": { + "default": "cabal-fmt", + "markdownDescription": "Set path to 'cabal-fmt' executable", + "scope": "resource", + "type": "string" + }, + "haskell.plugin.cabal.codeActionsOn": { + "default": true, + "description": "Enables cabal code actions", + "scope": "resource", + "type": "boolean" + }, + "haskell.plugin.cabal.completionOn": { + "default": true, + "description": "Enables cabal completions", + "scope": "resource", + "type": "boolean" + }, + "haskell.plugin.cabal.diagnosticsOn": { + "default": true, + "description": "Enables cabal diagnostics", + "scope": "resource", + "type": "boolean" + }, + "haskell.plugin.cabal.hoverOn": { + "default": true, + "description": "Enables cabal hover", + "scope": "resource", + "type": "boolean" + }, + "haskell.plugin.cabal.symbolsOn": { + "default": true, + "description": "Enables cabal symbols", + "scope": "resource", + "type": "boolean" + }, + "haskell.plugin.cabalHaskellIntegration.globalOn": { + "default": true, + "description": "Enables cabalHaskellIntegration plugin", + "scope": "resource", + "type": "boolean" + }, + "haskell.plugin.callHierarchy.globalOn": { + "default": true, + "description": "Enables callHierarchy plugin", + "scope": "resource", + "type": "boolean" + }, + "haskell.plugin.changeTypeSignature.globalOn": { + "default": true, + "description": "Enables changeTypeSignature plugin", + "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", + "scope": "resource", + "type": "boolean" + }, + "haskell.plugin.eval.config.exception": { + "default": false, + "markdownDescription": "Enable marking exceptions with `*** Exception:` similarly to doctest and GHCi.", + "scope": "resource", + "type": "boolean" + }, + "haskell.plugin.eval.globalOn": { + "default": true, + "description": "Enables eval plugin", + "scope": "resource", + "type": "boolean" + }, + "haskell.plugin.explicit-fields.codeActionsOn": { + "default": true, + "description": "Enables explicit-fields code actions", + "scope": "resource", + "type": "boolean" + }, + "haskell.plugin.explicit-fields.inlayHintsOn": { + "default": true, + "description": "Enables explicit-fields inlay hints", + "scope": "resource", + "type": "boolean" + }, + "haskell.plugin.explicit-fixity.globalOn": { + "default": true, + "description": "Enables explicit-fixity 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", + "scope": "resource", + "type": "boolean" + }, + "haskell.plugin.ghcide-completions.config.snippetsOn": { + "default": true, + "markdownDescription": "Inserts snippets when using code completions", + "scope": "resource", + "type": "boolean" + }, + "haskell.plugin.ghcide-completions.globalOn": { + "default": true, + "description": "Enables ghcide-completions plugin", + "scope": "resource", + "type": "boolean" + }, + "haskell.plugin.ghcide-hover-and-symbols.hoverOn": { + "default": true, + "description": "Enables ghcide-hover-and-symbols hover", + "scope": "resource", + "type": "boolean" + }, + "haskell.plugin.ghcide-hover-and-symbols.symbolsOn": { + "default": true, + "description": "Enables ghcide-hover-and-symbols symbols", + "scope": "resource", + "type": "boolean" + }, + "haskell.plugin.ghcide-type-lenses.config.mode": { + "default": "always", + "description": "Control how type lenses are shown", + "enum": [ + "always", + "exported", + "diagnostics" + ], + "enumDescriptions": [ + "Always displays type lenses of global bindings", + "Only display type lenses of exported global bindings", + "Follows error messages produced by GHC about missing signatures" + ], + "scope": "resource", + "type": "string" + }, + "haskell.plugin.ghcide-type-lenses.globalOn": { + "default": true, + "description": "Enables ghcide-type-lenses plugin", + "scope": "resource", + "type": "boolean" + }, + "haskell.plugin.importLens.codeActionsOn": { + "default": true, + "description": "Enables importLens code actions", + "scope": "resource", + "type": "boolean" + }, + "haskell.plugin.importLens.codeLensOn": { + "default": true, + "description": "Enables importLens code lenses", + "scope": "resource", + "type": "boolean" + }, + "haskell.plugin.importLens.inlayHintsOn": { + "default": true, + "description": "Enables importLens inlay hints", + "scope": "resource", + "type": "boolean" + }, + "haskell.plugin.moduleName.globalOn": { + "default": true, + "description": "Enables moduleName plugin", + "scope": "resource", + "type": "boolean" + }, + "haskell.plugin.overloaded-record-dot.globalOn": { + "default": true, + "description": "Enables overloaded-record-dot plugin", + "scope": "resource", + "type": "boolean" + }, + "haskell.plugin.pragmas-completion.globalOn": { + "default": true, + "description": "Enables pragmas-completion plugin", + "scope": "resource", + "type": "boolean" + }, + "haskell.plugin.pragmas-disable.globalOn": { + "default": true, + "description": "Enables pragmas-disable plugin", + "scope": "resource", + "type": "boolean" + }, + "haskell.plugin.pragmas-suggest.globalOn": { + "default": true, + "description": "Enables pragmas-suggest plugin", + "scope": "resource", + "type": "boolean" + }, + "haskell.plugin.qualifyImportedNames.globalOn": { + "default": true, + "description": "Enables qualifyImportedNames plugin", + "scope": "resource", + "type": "boolean" + }, + "haskell.plugin.semanticTokens.config.classMethodToken": { + "default": "method", + "description": "LSP semantic token type to use for typeclass methods", + "enum": [ + "namespace", + "type", + "class", + "enum", + "interface", + "struct", + "typeParameter", + "parameter", + "variable", + "property", + "enumMember", + "event", + "function", + "method", + "macro", + "keyword", + "modifier", + "comment", + "string", + "number", + "regexp", + "operator", + "decorator" + ], + "enumDescriptions": [ + "LSP Semantic Token Type: namespace", + "LSP Semantic Token Type: type", + "LSP Semantic Token Type: class", + "LSP Semantic Token Type: enum", + "LSP Semantic Token Type: interface", + "LSP Semantic Token Type: struct", + "LSP Semantic Token Type: typeParameter", + "LSP Semantic Token Type: parameter", + "LSP Semantic Token Type: variable", + "LSP Semantic Token Type: property", + "LSP Semantic Token Type: enumMember", + "LSP Semantic Token Type: event", + "LSP Semantic Token Type: function", + "LSP Semantic Token Type: method", + "LSP Semantic Token Type: macro", + "LSP Semantic Token Type: keyword", + "LSP Semantic Token Type: modifier", + "LSP Semantic Token Type: comment", + "LSP Semantic Token Type: string", + "LSP Semantic Token Type: number", + "LSP Semantic Token Type: regexp", + "LSP Semantic Token Type: operator", + "LSP Semantic Token Type: decorator" + ], + "scope": "resource", + "type": "string" + }, + "haskell.plugin.semanticTokens.config.classToken": { + "default": "class", + "description": "LSP semantic token type to use for typeclasses", + "enum": [ + "namespace", + "type", + "class", + "enum", + "interface", + "struct", + "typeParameter", + "parameter", + "variable", + "property", + "enumMember", + "event", + "function", + "method", + "macro", + "keyword", + "modifier", + "comment", + "string", + "number", + "regexp", + "operator", + "decorator" + ], + "enumDescriptions": [ + "LSP Semantic Token Type: namespace", + "LSP Semantic Token Type: type", + "LSP Semantic Token Type: class", + "LSP Semantic Token Type: enum", + "LSP Semantic Token Type: interface", + "LSP Semantic Token Type: struct", + "LSP Semantic Token Type: typeParameter", + "LSP Semantic Token Type: parameter", + "LSP Semantic Token Type: variable", + "LSP Semantic Token Type: property", + "LSP Semantic Token Type: enumMember", + "LSP Semantic Token Type: event", + "LSP Semantic Token Type: function", + "LSP Semantic Token Type: method", + "LSP Semantic Token Type: macro", + "LSP Semantic Token Type: keyword", + "LSP Semantic Token Type: modifier", + "LSP Semantic Token Type: comment", + "LSP Semantic Token Type: string", + "LSP Semantic Token Type: number", + "LSP Semantic Token Type: regexp", + "LSP Semantic Token Type: operator", + "LSP Semantic Token Type: decorator" + ], + "scope": "resource", + "type": "string" + }, + "haskell.plugin.semanticTokens.config.dataConstructorToken": { + "default": "enumMember", + "description": "LSP semantic token type to use for data constructors", + "enum": [ + "namespace", + "type", + "class", + "enum", + "interface", + "struct", + "typeParameter", + "parameter", + "variable", + "property", + "enumMember", + "event", + "function", + "method", + "macro", + "keyword", + "modifier", + "comment", + "string", + "number", + "regexp", + "operator", + "decorator" + ], + "enumDescriptions": [ + "LSP Semantic Token Type: namespace", + "LSP Semantic Token Type: type", + "LSP Semantic Token Type: class", + "LSP Semantic Token Type: enum", + "LSP Semantic Token Type: interface", + "LSP Semantic Token Type: struct", + "LSP Semantic Token Type: typeParameter", + "LSP Semantic Token Type: parameter", + "LSP Semantic Token Type: variable", + "LSP Semantic Token Type: property", + "LSP Semantic Token Type: enumMember", + "LSP Semantic Token Type: event", + "LSP Semantic Token Type: function", + "LSP Semantic Token Type: method", + "LSP Semantic Token Type: macro", + "LSP Semantic Token Type: keyword", + "LSP Semantic Token Type: modifier", + "LSP Semantic Token Type: comment", + "LSP Semantic Token Type: string", + "LSP Semantic Token Type: number", + "LSP Semantic Token Type: regexp", + "LSP Semantic Token Type: operator", + "LSP Semantic Token Type: decorator" + ], + "scope": "resource", + "type": "string" + }, + "haskell.plugin.semanticTokens.config.functionToken": { + "default": "function", + "description": "LSP semantic token type to use for functions", + "enum": [ + "namespace", + "type", + "class", + "enum", + "interface", + "struct", + "typeParameter", + "parameter", + "variable", + "property", + "enumMember", + "event", + "function", + "method", + "macro", + "keyword", + "modifier", + "comment", + "string", + "number", + "regexp", + "operator", + "decorator" + ], + "enumDescriptions": [ + "LSP Semantic Token Type: namespace", + "LSP Semantic Token Type: type", + "LSP Semantic Token Type: class", + "LSP Semantic Token Type: enum", + "LSP Semantic Token Type: interface", + "LSP Semantic Token Type: struct", + "LSP Semantic Token Type: typeParameter", + "LSP Semantic Token Type: parameter", + "LSP Semantic Token Type: variable", + "LSP Semantic Token Type: property", + "LSP Semantic Token Type: enumMember", + "LSP Semantic Token Type: event", + "LSP Semantic Token Type: function", + "LSP Semantic Token Type: method", + "LSP Semantic Token Type: macro", + "LSP Semantic Token Type: keyword", + "LSP Semantic Token Type: modifier", + "LSP Semantic Token Type: comment", + "LSP Semantic Token Type: string", + "LSP Semantic Token Type: number", + "LSP Semantic Token Type: regexp", + "LSP Semantic Token Type: operator", + "LSP Semantic Token Type: decorator" + ], + "scope": "resource", + "type": "string" + }, + "haskell.plugin.semanticTokens.config.moduleToken": { + "default": "namespace", + "description": "LSP semantic token type to use for modules", + "enum": [ + "namespace", + "type", + "class", + "enum", + "interface", + "struct", + "typeParameter", + "parameter", + "variable", + "property", + "enumMember", + "event", + "function", + "method", + "macro", + "keyword", + "modifier", + "comment", + "string", + "number", + "regexp", + "operator", + "decorator" + ], + "enumDescriptions": [ + "LSP Semantic Token Type: namespace", + "LSP Semantic Token Type: type", + "LSP Semantic Token Type: class", + "LSP Semantic Token Type: enum", + "LSP Semantic Token Type: interface", + "LSP Semantic Token Type: struct", + "LSP Semantic Token Type: typeParameter", + "LSP Semantic Token Type: parameter", + "LSP Semantic Token Type: variable", + "LSP Semantic Token Type: property", + "LSP Semantic Token Type: enumMember", + "LSP Semantic Token Type: event", + "LSP Semantic Token Type: function", + "LSP Semantic Token Type: method", + "LSP Semantic Token Type: macro", + "LSP Semantic Token Type: keyword", + "LSP Semantic Token Type: modifier", + "LSP Semantic Token Type: comment", + "LSP Semantic Token Type: string", + "LSP Semantic Token Type: number", + "LSP Semantic Token Type: regexp", + "LSP Semantic Token Type: operator", + "LSP Semantic Token Type: decorator" + ], + "scope": "resource", + "type": "string" + }, + "haskell.plugin.semanticTokens.config.operatorToken": { + "default": "operator", + "description": "LSP semantic token type to use for operators", + "enum": [ + "namespace", + "type", + "class", + "enum", + "interface", + "struct", + "typeParameter", + "parameter", + "variable", + "property", + "enumMember", + "event", + "function", + "method", + "macro", + "keyword", + "modifier", + "comment", + "string", + "number", + "regexp", + "operator", + "decorator" + ], + "enumDescriptions": [ + "LSP Semantic Token Type: namespace", + "LSP Semantic Token Type: type", + "LSP Semantic Token Type: class", + "LSP Semantic Token Type: enum", + "LSP Semantic Token Type: interface", + "LSP Semantic Token Type: struct", + "LSP Semantic Token Type: typeParameter", + "LSP Semantic Token Type: parameter", + "LSP Semantic Token Type: variable", + "LSP Semantic Token Type: property", + "LSP Semantic Token Type: enumMember", + "LSP Semantic Token Type: event", + "LSP Semantic Token Type: function", + "LSP Semantic Token Type: method", + "LSP Semantic Token Type: macro", + "LSP Semantic Token Type: keyword", + "LSP Semantic Token Type: modifier", + "LSP Semantic Token Type: comment", + "LSP Semantic Token Type: string", + "LSP Semantic Token Type: number", + "LSP Semantic Token Type: regexp", + "LSP Semantic Token Type: operator", + "LSP Semantic Token Type: decorator" + ], + "scope": "resource", + "type": "string" + }, + "haskell.plugin.semanticTokens.config.patternSynonymToken": { + "default": "macro", + "description": "LSP semantic token type to use for pattern synonyms", + "enum": [ + "namespace", + "type", + "class", + "enum", + "interface", + "struct", + "typeParameter", + "parameter", + "variable", + "property", + "enumMember", + "event", + "function", + "method", + "macro", + "keyword", + "modifier", + "comment", + "string", + "number", + "regexp", + "operator", + "decorator" + ], + "enumDescriptions": [ + "LSP Semantic Token Type: namespace", + "LSP Semantic Token Type: type", + "LSP Semantic Token Type: class", + "LSP Semantic Token Type: enum", + "LSP Semantic Token Type: interface", + "LSP Semantic Token Type: struct", + "LSP Semantic Token Type: typeParameter", + "LSP Semantic Token Type: parameter", + "LSP Semantic Token Type: variable", + "LSP Semantic Token Type: property", + "LSP Semantic Token Type: enumMember", + "LSP Semantic Token Type: event", + "LSP Semantic Token Type: function", + "LSP Semantic Token Type: method", + "LSP Semantic Token Type: macro", + "LSP Semantic Token Type: keyword", + "LSP Semantic Token Type: modifier", + "LSP Semantic Token Type: comment", + "LSP Semantic Token Type: string", + "LSP Semantic Token Type: number", + "LSP Semantic Token Type: regexp", + "LSP Semantic Token Type: operator", + "LSP Semantic Token Type: decorator" + ], + "scope": "resource", + "type": "string" + }, + "haskell.plugin.semanticTokens.config.recordFieldToken": { + "default": "property", + "description": "LSP semantic token type to use for record fields", + "enum": [ + "namespace", + "type", + "class", + "enum", + "interface", + "struct", + "typeParameter", + "parameter", + "variable", + "property", + "enumMember", + "event", + "function", + "method", + "macro", + "keyword", + "modifier", + "comment", + "string", + "number", + "regexp", + "operator", + "decorator" + ], + "enumDescriptions": [ + "LSP Semantic Token Type: namespace", + "LSP Semantic Token Type: type", + "LSP Semantic Token Type: class", + "LSP Semantic Token Type: enum", + "LSP Semantic Token Type: interface", + "LSP Semantic Token Type: struct", + "LSP Semantic Token Type: typeParameter", + "LSP Semantic Token Type: parameter", + "LSP Semantic Token Type: variable", + "LSP Semantic Token Type: property", + "LSP Semantic Token Type: enumMember", + "LSP Semantic Token Type: event", + "LSP Semantic Token Type: function", + "LSP Semantic Token Type: method", + "LSP Semantic Token Type: macro", + "LSP Semantic Token Type: keyword", + "LSP Semantic Token Type: modifier", + "LSP Semantic Token Type: comment", + "LSP Semantic Token Type: string", + "LSP Semantic Token Type: number", + "LSP Semantic Token Type: regexp", + "LSP Semantic Token Type: operator", + "LSP Semantic Token Type: decorator" + ], + "scope": "resource", + "type": "string" + }, + "haskell.plugin.semanticTokens.config.typeConstructorToken": { + "default": "enum", + "description": "LSP semantic token type to use for type constructors", + "enum": [ + "namespace", + "type", + "class", + "enum", + "interface", + "struct", + "typeParameter", + "parameter", + "variable", + "property", + "enumMember", + "event", + "function", + "method", + "macro", + "keyword", + "modifier", + "comment", + "string", + "number", + "regexp", + "operator", + "decorator" + ], + "enumDescriptions": [ + "LSP Semantic Token Type: namespace", + "LSP Semantic Token Type: type", + "LSP Semantic Token Type: class", + "LSP Semantic Token Type: enum", + "LSP Semantic Token Type: interface", + "LSP Semantic Token Type: struct", + "LSP Semantic Token Type: typeParameter", + "LSP Semantic Token Type: parameter", + "LSP Semantic Token Type: variable", + "LSP Semantic Token Type: property", + "LSP Semantic Token Type: enumMember", + "LSP Semantic Token Type: event", + "LSP Semantic Token Type: function", + "LSP Semantic Token Type: method", + "LSP Semantic Token Type: macro", + "LSP Semantic Token Type: keyword", + "LSP Semantic Token Type: modifier", + "LSP Semantic Token Type: comment", + "LSP Semantic Token Type: string", + "LSP Semantic Token Type: number", + "LSP Semantic Token Type: regexp", + "LSP Semantic Token Type: operator", + "LSP Semantic Token Type: decorator" + ], + "scope": "resource", + "type": "string" + }, + "haskell.plugin.semanticTokens.config.typeFamilyToken": { + "default": "interface", + "description": "LSP semantic token type to use for type families", + "enum": [ + "namespace", + "type", + "class", + "enum", + "interface", + "struct", + "typeParameter", + "parameter", + "variable", + "property", + "enumMember", + "event", + "function", + "method", + "macro", + "keyword", + "modifier", + "comment", + "string", + "number", + "regexp", + "operator", + "decorator" + ], + "enumDescriptions": [ + "LSP Semantic Token Type: namespace", + "LSP Semantic Token Type: type", + "LSP Semantic Token Type: class", + "LSP Semantic Token Type: enum", + "LSP Semantic Token Type: interface", + "LSP Semantic Token Type: struct", + "LSP Semantic Token Type: typeParameter", + "LSP Semantic Token Type: parameter", + "LSP Semantic Token Type: variable", + "LSP Semantic Token Type: property", + "LSP Semantic Token Type: enumMember", + "LSP Semantic Token Type: event", + "LSP Semantic Token Type: function", + "LSP Semantic Token Type: method", + "LSP Semantic Token Type: macro", + "LSP Semantic Token Type: keyword", + "LSP Semantic Token Type: modifier", + "LSP Semantic Token Type: comment", + "LSP Semantic Token Type: string", + "LSP Semantic Token Type: number", + "LSP Semantic Token Type: regexp", + "LSP Semantic Token Type: operator", + "LSP Semantic Token Type: decorator" + ], + "scope": "resource", + "type": "string" + }, + "haskell.plugin.semanticTokens.config.typeSynonymToken": { + "default": "type", + "description": "LSP semantic token type to use for type synonyms", + "enum": [ + "namespace", + "type", + "class", + "enum", + "interface", + "struct", + "typeParameter", + "parameter", + "variable", + "property", + "enumMember", + "event", + "function", + "method", + "macro", + "keyword", + "modifier", + "comment", + "string", + "number", + "regexp", + "operator", + "decorator" + ], + "enumDescriptions": [ + "LSP Semantic Token Type: namespace", + "LSP Semantic Token Type: type", + "LSP Semantic Token Type: class", + "LSP Semantic Token Type: enum", + "LSP Semantic Token Type: interface", + "LSP Semantic Token Type: struct", + "LSP Semantic Token Type: typeParameter", + "LSP Semantic Token Type: parameter", + "LSP Semantic Token Type: variable", + "LSP Semantic Token Type: property", + "LSP Semantic Token Type: enumMember", + "LSP Semantic Token Type: event", + "LSP Semantic Token Type: function", + "LSP Semantic Token Type: method", + "LSP Semantic Token Type: macro", + "LSP Semantic Token Type: keyword", + "LSP Semantic Token Type: modifier", + "LSP Semantic Token Type: comment", + "LSP Semantic Token Type: string", + "LSP Semantic Token Type: number", + "LSP Semantic Token Type: regexp", + "LSP Semantic Token Type: operator", + "LSP Semantic Token Type: decorator" + ], + "scope": "resource", + "type": "string" + }, + "haskell.plugin.semanticTokens.config.typeVariableToken": { + "default": "typeParameter", + "description": "LSP semantic token type to use for type variables", + "enum": [ + "namespace", + "type", + "class", + "enum", + "interface", + "struct", + "typeParameter", + "parameter", + "variable", + "property", + "enumMember", + "event", + "function", + "method", + "macro", + "keyword", + "modifier", + "comment", + "string", + "number", + "regexp", + "operator", + "decorator" + ], + "enumDescriptions": [ + "LSP Semantic Token Type: namespace", + "LSP Semantic Token Type: type", + "LSP Semantic Token Type: class", + "LSP Semantic Token Type: enum", + "LSP Semantic Token Type: interface", + "LSP Semantic Token Type: struct", + "LSP Semantic Token Type: typeParameter", + "LSP Semantic Token Type: parameter", + "LSP Semantic Token Type: variable", + "LSP Semantic Token Type: property", + "LSP Semantic Token Type: enumMember", + "LSP Semantic Token Type: event", + "LSP Semantic Token Type: function", + "LSP Semantic Token Type: method", + "LSP Semantic Token Type: macro", + "LSP Semantic Token Type: keyword", + "LSP Semantic Token Type: modifier", + "LSP Semantic Token Type: comment", + "LSP Semantic Token Type: string", + "LSP Semantic Token Type: number", + "LSP Semantic Token Type: regexp", + "LSP Semantic Token Type: operator", + "LSP Semantic Token Type: decorator" + ], + "scope": "resource", + "type": "string" + }, + "haskell.plugin.semanticTokens.config.variableToken": { + "default": "variable", + "description": "LSP semantic token type to use for variables", + "enum": [ + "namespace", + "type", + "class", + "enum", + "interface", + "struct", + "typeParameter", + "parameter", + "variable", + "property", + "enumMember", + "event", + "function", + "method", + "macro", + "keyword", + "modifier", + "comment", + "string", + "number", + "regexp", + "operator", + "decorator" + ], + "enumDescriptions": [ + "LSP Semantic Token Type: namespace", + "LSP Semantic Token Type: type", + "LSP Semantic Token Type: class", + "LSP Semantic Token Type: enum", + "LSP Semantic Token Type: interface", + "LSP Semantic Token Type: struct", + "LSP Semantic Token Type: typeParameter", + "LSP Semantic Token Type: parameter", + "LSP Semantic Token Type: variable", + "LSP Semantic Token Type: property", + "LSP Semantic Token Type: enumMember", + "LSP Semantic Token Type: event", + "LSP Semantic Token Type: function", + "LSP Semantic Token Type: method", + "LSP Semantic Token Type: macro", + "LSP Semantic Token Type: keyword", + "LSP Semantic Token Type: modifier", + "LSP Semantic Token Type: comment", + "LSP Semantic Token Type: string", + "LSP Semantic Token Type: number", + "LSP Semantic Token Type: regexp", + "LSP Semantic Token Type: operator", + "LSP Semantic Token Type: decorator" + ], + "scope": "resource", + "type": "string" + }, + "haskell.plugin.semanticTokens.globalOn": { + "default": false, + "description": "Enables semanticTokens plugin", + "scope": "resource", + "type": "boolean" + } +}