diff --git a/cabal.project b/cabal.project index 60ed590606d..2a30ca8ad32 100644 --- a/cabal.project +++ b/cabal.project @@ -1,5 +1,5 @@ packages: - ./ + -- ./ ./hie-compat ./shake-bench ./hls-graph @@ -8,41 +8,54 @@ packages: ./ghcide/test ./hls-plugin-api ./hls-test-utils - ./plugins/hls-cabal-plugin - ./plugins/hls-cabal-fmt-plugin - ./plugins/hls-tactics-plugin - ./plugins/hls-stylish-haskell-plugin - ./plugins/hls-fourmolu-plugin - ./plugins/hls-class-plugin - ./plugins/hls-eval-plugin - ./plugins/hls-explicit-imports-plugin - ./plugins/hls-refine-imports-plugin - ./plugins/hls-hlint-plugin - ./plugins/hls-rename-plugin - ./plugins/hls-retrie-plugin - ./plugins/hls-haddock-comments-plugin - ./plugins/hls-splice-plugin - ./plugins/hls-floskell-plugin - ./plugins/hls-pragmas-plugin - ./plugins/hls-module-name-plugin - ./plugins/hls-ormolu-plugin - ./plugins/hls-call-hierarchy-plugin - ./plugins/hls-alternate-number-format-plugin - ./plugins/hls-qualify-imported-names-plugin - ./plugins/hls-code-range-plugin - ./plugins/hls-change-type-signature-plugin - ./plugins/hls-stan-plugin - ./plugins/hls-gadt-plugin - ./plugins/hls-explicit-fixity-plugin - ./plugins/hls-explicit-record-fields-plugin - ./plugins/hls-refactor-plugin + /home/zubin/hiedb + /home/zubin/hie-bios + -- ./plugins/hls-cabal-plugin + -- ./plugins/hls-cabal-fmt-plugin + -- ./plugins/hls-tactics-plugin + -- ./plugins/hls-stylish-haskell-plugin + -- ./plugins/hls-fourmolu-plugin + -- ./plugins/hls-class-plugin + -- ./plugins/hls-eval-plugin + -- ./plugins/hls-explicit-imports-plugin + -- ./plugins/hls-refine-imports-plugin + -- ./plugins/hls-hlint-plugin + -- ./plugins/hls-rename-plugin + -- ./plugins/hls-retrie-plugin + -- ./plugins/hls-haddock-comments-plugin + -- ./plugins/hls-splice-plugin + -- ./plugins/hls-floskell-plugin + -- ./plugins/hls-pragmas-plugin + -- ./plugins/hls-module-name-plugin + -- ./plugins/hls-ormolu-plugin + -- ./plugins/hls-call-hierarchy-plugin + -- ./plugins/hls-alternate-number-format-plugin + -- ./plugins/hls-qualify-imported-names-plugin + -- ./plugins/hls-code-range-plugin + -- ./plugins/hls-change-type-signature-plugin + -- ./plugins/hls-stan-plugin + -- ./plugins/hls-gadt-plugin + -- ./plugins/hls-explicit-fixity-plugin + -- ./plugins/hls-explicit-record-fields-plugin + -- ./plugins/hls-refactor-plugin -- Standard location for temporary packages needed for particular environments -- For example it is used in the project gitlab mirror to help in the MAcOS M1 build script -- See https://github.com/haskell/haskell-language-server/blob/master/.gitlab-ci.yml optional-packages: vendored/*/*.cabal -tests: true +tests: false + + +source-repository-package + type:git + location: https://github.com/wz1000/HieDb + tag: e9edc2e1e2ffdd73ff33f51fad468df5237ea1b5 + +source-repository-package + type:git + location: https://github.com/haskell/hie-bios + tag: 8519812ad7501cab31347cd46ad1312b8413b8ad package * ghc-options: -haddock @@ -50,7 +63,7 @@ package * write-ghc-environment-files: never -index-state: 2023-01-10T00:00:00Z +index-state: 2023-01-31T00:00:00Z constraints: -- For GHC 9.4, older versions of entropy fail to build on Windows @@ -74,14 +87,18 @@ constraints: -- centos7 has an old version of git which cabal doesn't -- support. We delete these lines in gitlab ci to workaround -- this issue, as this is not necessary to build our binaries. -source-repository-package - type:git - location: https://github.com/pepeiborra/ekg-json - tag: 7a0af7a8fd38045fd15fb13445bdcc7085325460 - -- https://github.com/tibbe/ekg-json/pull/12 -- END DELETE allow-newer: + -- ghc-9.6 + template-haskell, + base, + ghc-prim, + ghc, + ghc-boot, + mtl, + transformers, + Cabal, -- ghc-9.4 Chart-diagrams:lens, Chart:lens, @@ -104,3 +121,14 @@ allow-newer: uuid:time, vector-space:base, ekg-wai:time, + +repository head.hackage.ghc.haskell.org + url: https://ghc.gitlab.haskell.org/head.hackage/ + secure: True + key-threshold: 3 + root-keys: + f76d08be13e9a61a377a85e2fb63f4c5435d40f8feb3e12eb05905edb8cdea89 + 26021a13b401500c8eb2761ca95c61f2d625bfef951b939a8124ed12ecf07329 + 7541f32a4ccca4f97aea3b22f5e593ba2c0267546016b992dfadcd2fe944e55d + +active-repositories: hackage.haskell.org, head.hackage.ghc.haskell.org:override diff --git a/ghcide/src/Development/IDE/Core/Compile.hs b/ghcide/src/Development/IDE/Core/Compile.hs index d491766cc29..75c8d316920 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 , TypecheckHelpers(..) ) where +import Control.Monad.IO.Class import Control.Concurrent.Extra import Control.Concurrent.STM.Stats hiding (orElse) import Control.DeepSeq (NFData (..), force, liftRnf, @@ -133,6 +134,13 @@ import GHC.Hs (LEpaComment) import qualified GHC.Types.Error as Error #endif +#if MIN_VERSION_ghc(9,5,0) +import GHC.Driver.Config.CoreToStg.Prep +import GHC.Core.Lint.Interactive +import GHC.Driver.Main (mkCgInteractiveGuts) +import GHC.Unit.Home.ModInfo +#endif + -- | Given a string buffer, return the string (after preprocessing) and the 'ParsedModule'. parseModule :: IdeOptions @@ -467,7 +475,11 @@ mkHiFileResultNoCompile session tcm = do tcGblEnv = tmrTypechecked tcm details <- makeSimpleDetails hsc_env_tmp tcGblEnv sf <- finalSafeMode (ms_hspp_opts ms) tcGblEnv - iface' <- mkIfaceTc hsc_env_tmp sf details ms tcGblEnv + iface' <- mkIfaceTc hsc_env_tmp sf details ms +#if MIN_VERSION_ghc(9,5,0) + Nothing +#endif + tcGblEnv let iface = iface' { mi_globals = Nothing, mi_usages = filterUsages (mi_usages iface') } -- See Note [Clearing mi_globals after generating an iface] pure $! mkHiFileResult ms iface details (tmrRuntimeModules tcm) Nothing @@ -482,20 +494,19 @@ mkHiFileResultCompile se session' tcm simplified_guts = catchErrs $ do ms = pm_mod_summary $ tmrParsed tcm tcGblEnv = tmrTypechecked tcm - (details, mguts) <- - if mg_hsc_src simplified_guts == HsBootFile - then do - details <- mkBootModDetailsTc session tcGblEnv - pure (details, Nothing) - else do + (details, guts) <- do -- write core file -- give variables unique OccNames tidy_opts <- initTidyOpts session (guts, details) <- tidyProgram tidy_opts simplified_guts - pure (details, Just guts) + pure (details, guts) #if MIN_VERSION_ghc(9,0,1) - let !partial_iface = force $ mkPartialIface session details + let !partial_iface = force $ mkPartialIface session +#if MIN_VERSION_ghc(9,5,0) + (cg_binds guts) +#endif + details #if MIN_VERSION_ghc(9,3,0) ms #endif @@ -513,9 +524,7 @@ mkHiFileResultCompile se session' tcm simplified_guts = catchErrs $ do let final_iface = final_iface' {mi_globals = Nothing, mi_usages = filterUsages (mi_usages final_iface')} -- See Note [Clearing mi_globals after generating an iface] -- Write the core file now - core_file <- case mguts of - Nothing -> pure Nothing -- no guts, likely boot file - Just guts -> do + core_file <- do let core_fp = ml_core_file $ ms_location ms core_file = codeGutsToCoreFile iface_hash guts iface_hash = getModuleHash final_iface @@ -538,13 +547,23 @@ mkHiFileResultCompile se session' tcm simplified_guts = catchErrs $ do Just (core, _) | optVerifyCoreFile -> do let core_fp = ml_core_file $ ms_location ms traceIO $ "Verifying " ++ core_fp - let CgGuts{cg_binds = unprep_binds, cg_tycons = tycons } = case mguts of - Nothing -> error "invariant optVerifyCoreFile: guts must exist if linkable exists" - Just g -> g + let CgGuts{cg_binds = unprep_binds, cg_tycons = tycons } = guts mod = ms_mod ms data_tycons = filter isDataTyCon tycons CgGuts{cg_binds = unprep_binds'} <- coreFileToCgGuts session final_iface details core +#if MIN_VERSION_ghc(9,5,0) + cp_cfg <- initCorePrepConfig session +#endif + + let corePrep = corePrepPgm +#if MIN_VERSION_ghc(9,5,0) + (hsc_logger session) cp_cfg (initCorePrepPgmConfig (hsc_dflags session) (interactiveInScope $ hsc_IC session)) +#else + session +#endif + mod (ms_location ms) + -- Run corePrep first as we want to test the final version of the program that will -- get translated to STG/Bytecode #if MIN_VERSION_ghc(9,3,0) @@ -552,13 +571,13 @@ mkHiFileResultCompile se session' tcm simplified_guts = catchErrs $ do #else (prepd_binds , _) #endif - <- corePrepPgm session mod (ms_location ms) unprep_binds data_tycons + <- corePrep unprep_binds data_tycons #if MIN_VERSION_ghc(9,3,0) prepd_binds' #else (prepd_binds', _) #endif - <- corePrepPgm session mod (ms_location ms) unprep_binds' data_tycons + <- corePrep unprep_binds' data_tycons let binds = noUnfoldings $ (map flattenBinds . (:[])) $ prepd_binds binds' = noUnfoldings $ (map flattenBinds . (:[])) $ prepd_binds' @@ -683,7 +702,7 @@ generateByteCode (CoreFileTime time) hscEnv summary guts = 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 guts + hscInteractive session (mkCgInteractiveGuts guts) (ms_location summary') let unlinked = BCOs bytecode sptEntries let linkable = LM time (ms_mod summary) [unlinked] @@ -1242,7 +1261,9 @@ parseHeader => DynFlags -- ^ flags to use -> FilePath -- ^ the filename (for source locations) -> Util.StringBuffer -- ^ Haskell module source text (full Unicode is supported) -#if MIN_VERSION_ghc(9,0,1) +#if MIN_VERSION_ghc(9,5,0) + -> ExceptT [FileDiagnostic] m ([FileDiagnostic], Located(HsModule GhcPs)) +#elif MIN_VERSION_ghc(9,0,1) -> ExceptT [FileDiagnostic] m ([FileDiagnostic], Located(HsModule)) #else -> ExceptT [FileDiagnostic] m ([FileDiagnostic], Located(HsModule GhcPs)) @@ -1574,13 +1595,13 @@ showReason (RecompBecause s) = s mkDetailsFromIface :: HscEnv -> ModIface -> IO ModDetails mkDetailsFromIface session iface = do fixIO $ \details -> do - let !hsc' = hscUpdateHPT (\hpt -> addToHpt hpt (moduleName $ mi_module iface) (HomeModInfo iface details Nothing)) session + let !hsc' = hscUpdateHPT (\hpt -> addToHpt hpt (moduleName $ mi_module iface) (HomeModInfo iface details emptyHomeModInfoLinkable)) session initIfaceLoad hsc' (typecheckIface iface) coreFileToCgGuts :: HscEnv -> ModIface -> ModDetails -> CoreFile -> IO CgGuts coreFileToCgGuts session iface details core_file = do let act hpt = addToHpt hpt (moduleName this_mod) - (HomeModInfo iface details Nothing) + (HomeModInfo iface details emptyHomeModInfoLinkable) this_mod = mi_module iface types_var <- newIORef (md_types details) let hsc_env' = hscUpdateHPT act (session { @@ -1604,9 +1625,9 @@ coreFileToLinkable :: LinkableType -> HscEnv -> ModSummary -> ModIface -> ModDet coreFileToLinkable linkableType session ms iface details core_file t = do cgi_guts <- coreFileToCgGuts session iface details core_file (warns, lb) <- case linkableType of - BCOLinkable -> generateByteCode (CoreFileTime t) session ms cgi_guts - ObjectLinkable -> generateObjectCode session ms cgi_guts - pure (warns, HomeModInfo iface details . Just <$> lb) + BCOLinkable -> fmap (maybe emptyHomeModInfoLinkable justBytecode) <$> generateByteCode (CoreFileTime t) session ms cgi_guts + ObjectLinkable -> fmap (maybe emptyHomeModInfoLinkable justObjects) <$> generateObjectCode session ms cgi_guts + pure (warns, Just $ HomeModInfo iface details lb) -- TODO wz1000 handle emptyHomeModInfoLinkable -- | Non-interactive, batch version of 'InteractiveEval.getDocs'. -- The interactive paths create problems in ghc-lib builds diff --git a/ghcide/src/Development/IDE/Core/Rules.hs b/ghcide/src/Development/IDE/Core/Rules.hs index 71f278b798a..6e4f6c2620f 100644 --- a/ghcide/src/Development/IDE/Core/Rules.hs +++ b/ghcide/src/Development/IDE/Core/Rules.hs @@ -62,6 +62,7 @@ module Development.IDE.Core.Rules( DisplayTHWarning(..), ) where +import Control.Applicative import Control.Concurrent.Async (concurrently) import Control.Concurrent.Strict import Control.DeepSeq @@ -160,6 +161,9 @@ import Control.Monad.IO.Unlift import GHC.Unit.Module.Graph import GHC.Unit.Env #endif +#if MIN_VERSION_ghc(9,5,0) +import GHC.Unit.Home.ModInfo +#endif data Log = LogShake Shake.Log @@ -775,7 +779,7 @@ ghcSessionDepsDefinition fullModSummary GhcSessionDepsConfig{..} env file = do depSessions <- map hscEnv <$> uses_ (GhcSessionDeps_ fullModSummary) deps ifaces <- uses_ GetModIface deps - let inLoadOrder = map (\HiFileResult{..} -> HomeModInfo hirModIface hirModDetails Nothing) ifaces + let inLoadOrder = map (\HiFileResult{..} -> HomeModInfo hirModIface hirModDetails emptyHomeModInfoLinkable) ifaces #if MIN_VERSION_ghc(9,3,0) -- On GHC 9.4+, the module graph contains not only ModSummary's but each `ModuleNode` in the graph -- also points to all the direct descendants of the current module. To get the keys for the descendants @@ -1099,10 +1103,10 @@ getLinkableRule recorder = else pure Nothing case mobj_time of Just obj_t - | obj_t >= core_t -> pure ([], Just $ HomeModInfo hirModIface hirModDetails (Just $ LM (posixSecondsToUTCTime obj_t) (ms_mod ms) [DotO obj_file])) + | obj_t >= core_t -> pure ([], Just $ HomeModInfo hirModIface hirModDetails (justObjects $ LM (posixSecondsToUTCTime obj_t) (ms_mod ms) [DotO obj_file])) _ -> liftIO $ coreFileToLinkable linkableType (hscEnv session) ms 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 (hm_linkable =<< hmi) $ \(LM time mod _) -> do + whenJust ((homeModInfoByteCode =<< hmi) <|> (homeModInfoObject =<< hmi)) $ \(LM time mod _) -> do compiledLinkables <- getCompiledLinkables <$> getIdeGlobalAction liftIO $ modifyVar compiledLinkables $ \old -> do let !to_keep = extendModuleEnv old mod time diff --git a/ghcide/src/Development/IDE/GHC/CPP.hs b/ghcide/src/Development/IDE/GHC/CPP.hs index 7495de21a4c..165cdf9378a 100644 --- a/ghcide/src/Development/IDE/GHC/CPP.hs +++ b/ghcide/src/Development/IDE/GHC/CPP.hs @@ -15,6 +15,7 @@ module Development.IDE.GHC.CPP(doCpp, addOptP) where +import Control.Monad import Development.IDE.GHC.Compat as Compat import Development.IDE.GHC.Compat.Util import GHC @@ -42,6 +43,8 @@ addOptP f = alterToolSettings $ \s -> s doCpp :: HscEnv -> Bool -> FilePath -> FilePath -> IO () doCpp env raw input_fn output_fn = #if MIN_VERSION_ghc (9,2,0) + void $ Pipeline.runCppPhase env input_fn output_fn -- TODO wz1000 +#elif MIN_VERSION_ghc (9,2,0) Pipeline.doCpp (hsc_logger env) (hsc_tmpfs env) (hsc_dflags env) (hsc_unit_env env) raw input_fn output_fn #else Pipeline.doCpp (hsc_dflags env) raw input_fn output_fn diff --git a/ghcide/src/Development/IDE/GHC/Compat.hs b/ghcide/src/Development/IDE/GHC/Compat.hs index 49f2869a3b5..e49e21a3ec7 100644 --- a/ghcide/src/Development/IDE/GHC/Compat.hs +++ b/ghcide/src/Development/IDE/GHC/Compat.hs @@ -156,7 +156,15 @@ import Data.String (IsString (fromString)) #if MIN_VERSION_ghc(9,0,0) +#if MIN_VERSION_ghc(9,5,0) +import GHC.Core.Lint.Interactive (interactiveInScope) +import GHC.Driver.Config.Core.Lint.Interactive (lintInteractiveExpr) +import GHC.Driver.Config.Core.Opt.Simplify (initSimplifyExprOpts) +import GHC.Driver.Config.CoreToStg (initCoreToStgOpts) +import GHC.Driver.Config.CoreToStg.Prep (initCorePrepConfig) +#else import GHC.Core.Lint (lintInteractiveExpr) +#endif import qualified GHC.Core.Opt.Pipeline as GHC import GHC.Core.Tidy (tidyExpr) import GHC.CoreToStg.Prep (corePrepPgm) @@ -309,7 +317,11 @@ myCoreToStgExpr logger dflags ictxt binding for the stg2stg step) -} let bco_tmp_id = mkSysLocal (fsLit "BCO_toplevel") (mkPseudoUniqueE 0) +#if MIN_VERSION_ghc(9,5,0) + ManyTy +#else Many +#endif (exprType prepd_expr) (stg_binds, prov_map, collected_ccs) <- myCoreToStg logger @@ -342,7 +354,13 @@ myCoreToStg logger dflags ictxt this_mod ml prepd_binds = do let (stg_binds, denv, cost_centre_info) = {-# SCC "Core2Stg" #-} - coreToStg dflags this_mod ml prepd_binds + coreToStg +#if MIN_VERSION_ghc(9,5,0) + (initCoreToStgOpts dflags) +#else + dflags +#endif + this_mod ml prepd_binds #if MIN_VERSION_ghc(9,4,2) (stg_binds2,_) @@ -351,7 +369,13 @@ myCoreToStg logger dflags ictxt #endif <- {-# SCC "Stg2Stg" #-} #if MIN_VERSION_ghc(9,3,0) - stg2stg logger ictxt (initStgPipelineOpts dflags for_bytecode) this_mod stg_binds + stg2stg logger +#if MIN_VERSION_ghc(9,5,0) + (interactiveInScope ictxt) +#else + ictxt +#endif + (initStgPipelineOpts dflags for_bytecode) this_mod stg_binds #else stg2stg logger dflags ictxt this_mod stg_binds #endif @@ -379,10 +403,21 @@ getDependentMods = map fst . dep_mods . mi_deps simplifyExpr :: DynFlags -> HscEnv -> CoreExpr -> IO CoreExpr #if MIN_VERSION_ghc(9,0,0) +#if MIN_VERSION_ghc(9,5,0) +simplifyExpr _ env = GHC.simplifyExpr (Development.IDE.GHC.Compat.Env.hsc_logger env) (ue_eps (Development.IDE.GHC.Compat.Env.hsc_unit_env env)) (initSimplifyExprOpts (hsc_dflags env) (hsc_IC env)) +#else simplifyExpr _ = GHC.simplifyExpr +#endif corePrepExpr :: DynFlags -> HscEnv -> CoreExpr -> IO CoreExpr +#if MIN_VERSION_ghc(9,5,0) +corePrepExpr _ env exp = do + cfg <- initCorePrepConfig env + GHC.corePrepExpr (Development.IDE.GHC.Compat.Env.hsc_logger env) cfg exp +#else corePrepExpr _ = GHC.corePrepExpr +#endif + #else simplifyExpr df _ = GHC.simplifyExpr df #endif diff --git a/ghcide/src/Development/IDE/GHC/Compat/Core.hs b/ghcide/src/Development/IDE/GHC/Compat/Core.hs index 4dc0e221153..7e93e4fee4d 100644 --- a/ghcide/src/Development/IDE/GHC/Compat/Core.hs +++ b/ghcide/src/Development/IDE/GHC/Compat/Core.hs @@ -262,8 +262,7 @@ module Development.IDE.GHC.Compat.Core ( SrcLoc.srcLocLine, SrcLoc.noSrcSpan, SrcLoc.noSrcLoc, - SrcLoc.noLoc, - SrcLoc.mapLoc, + mapLoc, -- * Finder FindResult(..), mkHomeModLocation, @@ -1183,3 +1182,9 @@ type UniqFM = UniqFM.UniqFM #else type UniqFM k = UniqFM.UniqFM #endif + +#if MIN_VERSION_ghc(9,5,0) +mkVisFunTys = mkScaledFunctionTys +mapLoc :: (a -> b) -> SrcLoc.GenLocated l a -> SrcLoc.GenLocated l b +mapLoc = fmap +#endif diff --git a/ghcide/src/Development/IDE/GHC/Compat/Env.hs b/ghcide/src/Development/IDE/GHC/Compat/Env.hs index 596593376d8..25ea24123b1 100644 --- a/ghcide/src/Development/IDE/GHC/Compat/Env.hs +++ b/ghcide/src/Development/IDE/GHC/Compat/Env.hs @@ -82,7 +82,11 @@ import qualified GHC.Driver.Ways as Ways #endif import GHC.Driver.Hooks (Hooks) import GHC.Driver.Session hiding (mkHomeModule) +#if __GLASGOW_HASKELL__ >= 905 +import Language.Haskell.Syntax.Module.Name +#else import GHC.Unit.Module.Name +#endif import GHC.Unit.Types (Module, Unit, UnitId, mkModule) #else import DynFlags @@ -230,7 +234,9 @@ mkHomeModule = setBytecodeLinkerOptions :: DynFlags -> DynFlags setBytecodeLinkerOptions df = df { ghcLink = LinkInMemory -#if MIN_VERSION_ghc(9,2,0) +#if MIN_VERSION_ghc(9,5,0) + , backend = noBackend +#elif MIN_VERSION_ghc(9,2,0) , backend = NoBackend #else , hscTarget = HscNothing @@ -241,7 +247,9 @@ setBytecodeLinkerOptions df = df { setInterpreterLinkerOptions :: DynFlags -> DynFlags setInterpreterLinkerOptions df = df { ghcLink = LinkInMemory -#if MIN_VERSION_ghc(9,2,0) +#if MIN_VERSION_ghc(9,5,0) + , backend = interpreterBackend +#elif MIN_VERSION_ghc(9,2,0) , backend = Interpreter #else , hscTarget = HscInterpreted diff --git a/ghcide/src/Development/IDE/GHC/Compat/Logger.hs b/ghcide/src/Development/IDE/GHC/Compat/Logger.hs index cffac134aba..d7bc9deadc6 100644 --- a/ghcide/src/Development/IDE/GHC/Compat/Logger.hs +++ b/ghcide/src/Development/IDE/GHC/Compat/Logger.hs @@ -49,7 +49,11 @@ type LogActionCompat = LogFlags -> Maybe DiagnosticReason -> Maybe Severity -> S -- alwaysQualify seems to still do the right thing here, according to the "unqualified warnings" test. logActionCompat :: LogActionCompat -> LogAction +#if MIN_VERSION_ghc(9,5,0) +logActionCompat logAction logFlags (MCDiagnostic severity wr _) loc = logAction logFlags (Just wr) (Just severity) loc alwaysQualify +#else logActionCompat logAction logFlags (MCDiagnostic severity wr) loc = logAction logFlags (Just wr) (Just severity) loc alwaysQualify +#endif logActionCompat logAction logFlags _cls loc = logAction logFlags Nothing Nothing loc alwaysQualify #else diff --git a/ghcide/src/Development/IDE/GHC/Compat/Outputable.hs b/ghcide/src/Development/IDE/GHC/Compat/Outputable.hs index f34f03658f7..b04872d8925 100644 --- a/ghcide/src/Development/IDE/GHC/Compat/Outputable.hs +++ b/ghcide/src/Development/IDE/GHC/Compat/Outputable.hs @@ -9,7 +9,6 @@ module Development.IDE.GHC.Compat.Outputable ( ppr, pprPanic, text, vcat, (<+>), ($$), empty, hang, nest, punctuate, printSDocQualifiedUnsafe, printWithoutUniques, - mkPrintUnqualified, mkPrintUnqualifiedDefault, PrintUnqualified(..), defaultUserStyle, @@ -86,6 +85,10 @@ import GHC.Driver.Config.Diagnostic import GHC.Utils.Logger #endif +#if MIN_VERSION_ghc(9,3,0) +type PrintUnqualified = NamePprCtx +#endif + -- | A compatible function to print `Outputable` instances -- without unique symbols. -- @@ -203,7 +206,11 @@ type WarnMsg = MsgEnvelope DecoratedSDoc mkPrintUnqualifiedDefault :: HscEnv -> GlobalRdrEnv -> PrintUnqualified mkPrintUnqualifiedDefault env = -#if MIN_VERSION_ghc(9,2,0) +#if MIN_VERSION_ghc(9,5,0) + mkNamePprCtx ptc (hsc_unit_env env) + where + ptc = initPromotionTickContext (hsc_dflags env) +#elif MIN_VERSION_ghc(9,2,0) -- GHC 9.2 version -- mkPrintUnqualified :: UnitEnv -> GlobalRdrEnv -> PrintUnqualified mkPrintUnqualified (hsc_unit_env env) @@ -212,8 +219,13 @@ mkPrintUnqualifiedDefault env = #endif #if MIN_VERSION_ghc(9,3,0) -renderDiagnosticMessageWithHints :: Diagnostic a => a -> DecoratedSDoc -renderDiagnosticMessageWithHints a = Error.unionDecoratedSDoc (diagnosticMessage a) (mkDecorated $ map ppr $ diagnosticHints a) +renderDiagnosticMessageWithHints :: forall a. Diagnostic a => a -> DecoratedSDoc +renderDiagnosticMessageWithHints a = Error.unionDecoratedSDoc + (diagnosticMessage +#if MIN_VERSION_ghc(9,5,0) + (defaultDiagnosticOpts @a) +#endif + a) (mkDecorated $ map ppr $ diagnosticHints a) #endif #if MIN_VERSION_ghc(9,3,0) diff --git a/ghcide/src/Development/IDE/GHC/Compat/Parser.hs b/ghcide/src/Development/IDE/GHC/Compat/Parser.hs index 11773d233c5..2fd5b74efde 100644 --- a/ghcide/src/Development/IDE/GHC/Compat/Parser.hs +++ b/ghcide/src/Development/IDE/GHC/Compat/Parser.hs @@ -120,7 +120,11 @@ type ApiAnns = Anno.ApiAnns #endif #if MIN_VERSION_ghc(9,2,0) +#if MIN_VERSION_ghc(9,5,0) +pattern HsParsedModule :: Located (HsModule GhcPs) -> [FilePath] -> ApiAnns -> GHC.HsParsedModule +#else pattern HsParsedModule :: Located HsModule -> [FilePath] -> ApiAnns -> GHC.HsParsedModule +#endif pattern HsParsedModule { hpm_module , hpm_src_files diff --git a/ghcide/src/Development/IDE/GHC/Compat/Units.hs b/ghcide/src/Development/IDE/GHC/Compat/Units.hs index a96c8be5647..4bf7454ab5a 100644 --- a/ghcide/src/Development/IDE/GHC/Compat/Units.hs +++ b/ghcide/src/Development/IDE/GHC/Compat/Units.hs @@ -99,6 +99,7 @@ import qualified Packages import Development.IDE.GHC.Compat.Core import Development.IDE.GHC.Compat.Env +import Development.IDE.GHC.Compat.Outputable #if MIN_VERSION_ghc(9,0,0) && !MIN_VERSION_ghc(9,2,0) import Data.Map (Map) #endif @@ -400,7 +401,7 @@ filterInplaceUnits us packageFlags = #endif isInplace p = Right p -showSDocForUser' :: HscEnv -> GHC.PrintUnqualified -> SDoc -> String +showSDocForUser' :: HscEnv -> PrintUnqualified -> SDoc -> String #if MIN_VERSION_ghc(9,2,0) showSDocForUser' env = showSDocForUser (hsc_dflags env) (unitState env) #else diff --git a/ghcide/src/Development/IDE/GHC/CoreFile.hs b/ghcide/src/Development/IDE/GHC/CoreFile.hs index 737441f9ef1..7f48a063d92 100644 --- a/ghcide/src/Development/IDE/GHC/CoreFile.hs +++ b/ghcide/src/Development/IDE/GHC/CoreFile.hs @@ -134,7 +134,7 @@ codeGutsToCoreFile :: Fingerprint -- ^ Hash of the interface this was generated from -> CgGuts -> CoreFile -codeGutsToCoreFile hash CgGuts{..} = CoreFile (map (toIfaceTopBind cg_module) $ filter isNotImplictBind cg_binds) hash +codeGutsToCoreFile hash CgGuts{..} = CoreFile (map (toIfaceTopBind1 cg_module) $ filter isNotImplictBind cg_binds) hash -- | Implicit binds can be generated from the interface and are not tidied, -- so we must filter them out @@ -163,21 +163,21 @@ getClassImplicitBinds cls get_defn :: Id -> CoreBind get_defn id = NonRec id (unfoldingTemplate (realIdUnfolding id)) -toIfaceTopBndr :: Module -> Id -> IfaceId -toIfaceTopBndr mod id +toIfaceTopBndr1 :: Module -> Id -> IfaceId +toIfaceTopBndr1 mod id = IfaceId (mangleDeclName mod $ getName id) (toIfaceType (idType id)) (toIfaceIdDetails (idDetails id)) (toIfaceIdInfo (idInfo id)) -toIfaceTopBind :: Module -> Bind Id -> TopIfaceBinding IfaceId -toIfaceTopBind mod (NonRec b r) = TopIfaceNonRec (toIfaceTopBndr mod b) (toIfaceExpr r) -toIfaceTopBind mod (Rec prs) = TopIfaceRec [(toIfaceTopBndr mod b, toIfaceExpr r) | (b,r) <- prs] +toIfaceTopBind1 :: Module -> Bind Id -> TopIfaceBinding IfaceId +toIfaceTopBind1 mod (NonRec b r) = TopIfaceNonRec (toIfaceTopBndr1 mod b) (toIfaceExpr r) +toIfaceTopBind1 mod (Rec prs) = TopIfaceRec [(toIfaceTopBndr1 mod b, toIfaceExpr r) | (b,r) <- prs] typecheckCoreFile :: Module -> IORef TypeEnv -> CoreFile -> IfG CoreProgram typecheckCoreFile this_mod type_var (CoreFile prepd_binding _) = initIfaceLcl this_mod (text "typecheckCoreFile") NotBoot $ do - tcTopIfaceBindings type_var prepd_binding + tcTopIfaceBindings1 type_var prepd_binding -- | Internal names can't be serialized, so we mange them -- to an external name and restore at deserialization time @@ -199,9 +199,9 @@ isGhcideModule mod = "GHCIDEINTERNAL" `isPrefixOf` (moduleNameString $ moduleNam isGhcideName :: Name -> Bool isGhcideName = isGhcideModule . nameModule -tcTopIfaceBindings :: IORef TypeEnv -> [TopIfaceBinding IfaceId] +tcTopIfaceBindings1 :: IORef TypeEnv -> [TopIfaceBinding IfaceId] -> IfL [CoreBind] -tcTopIfaceBindings ty_var ver_decls +tcTopIfaceBindings1 ty_var ver_decls = do int <- mapM (traverse $ tcIfaceId) ver_decls let all_ids = concatMap toList int diff --git a/ghcide/src/Development/IDE/GHC/Orphans.hs b/ghcide/src/Development/IDE/GHC/Orphans.hs index 9e3d206d0e4..563a10b5eba 100644 --- a/ghcide/src/Development/IDE/GHC/Orphans.hs +++ b/ghcide/src/Development/IDE/GHC/Orphans.hs @@ -46,6 +46,9 @@ import ByteCodeTypes #if MIN_VERSION_ghc(9,3,0) import GHC.Types.PkgQual #endif +#if MIN_VERSION_ghc(9,5,0) +import GHC.Unit.Home.ModInfo +#endif -- Orphan instances for types from the GHC API. instance Show CoreModule where show = unpack . printOutputable @@ -92,8 +95,10 @@ instance Show Module where instance Outputable a => Show (GenLocated SrcSpan a) where show = unpack . printOutputable #endif +#if !MIN_VERSION_ghc(9,5,0) instance (NFData l, NFData e) => NFData (GenLocated l e) where rnf (L l e) = rnf l `seq` rnf e +#endif instance Show ModSummary where show = show . ms_mod @@ -184,8 +189,10 @@ instance NFData Type where instance Show a => Show (Bag a) where show = show . bagToList +#if !MIN_VERSION_ghc(9,5,0) instance NFData HsDocString where rnf = rwhnf +#endif instance Show ModGuts where show _ = "modguts" @@ -195,7 +202,9 @@ instance NFData ModGuts where instance NFData (ImportDecl GhcPs) where rnf = rwhnf -#if MIN_VERSION_ghc(9,0,1) +#if MIN_VERSION_ghc(9,5,0) +instance (NFData (HsModule a)) where +#elif MIN_VERSION_ghc(9,0,1) instance (NFData HsModule) where #else instance (NFData (HsModule a)) where @@ -222,3 +231,8 @@ instance NFData UnitId where instance NFData NodeKey where rnf = rwhnf #endif + +#if MIN_VERSION_ghc(9,5,0) +instance NFData HomeModLinkable where + rnf = rwhnf +#endif diff --git a/ghcide/src/Development/IDE/LSP/Outline.hs b/ghcide/src/Development/IDE/LSP/Outline.hs index b31cd90f7b6..e9cfd12c2c3 100644 --- a/ghcide/src/Development/IDE/LSP/Outline.hs +++ b/ghcide/src/Development/IDE/LSP/Outline.hs @@ -111,7 +111,7 @@ documentSymbolForDecl (L (locA -> (RealSrcSpan l _)) (TyClD _ DataDecl { tcdLNam #if MIN_VERSION_ghc(9,2,0) , _children = List . toList <$> nonEmpty childs } - | con <- dd_cons + | con <- extract_cons dd_cons , let (cs, flds) = hsConDeclsBinders con , let childs = mapMaybe cvtFld flds , L (locA -> RealSrcSpan l' _) n <- cs @@ -291,7 +291,7 @@ hsConDeclsBinders cons -- remove only the first occurrence of any seen field in order to -- avoid circumventing detection of duplicate fields (#9156) ConDeclGADT { con_names = names, con_g_args = args } - -> (names, flds) + -> (toList names, flds) where flds = get_flds_gadt args @@ -318,3 +318,11 @@ hsConDeclsBinders cons -> ([LFieldOcc GhcPs]) get_flds flds = concatMap (cd_fld_names . unLoc) (unLoc flds) #endif + + +#if MIN_VERSION_ghc(9,5,0) +extract_cons (NewTypeCon x) = [x] +extract_cons (DataTypeCons _ xs) = xs +#else +extract_cons = id +#endif diff --git a/ghcide/src/Development/IDE/Plugin/Completions.hs b/ghcide/src/Development/IDE/Plugin/Completions.hs index 0442acef148..9dc28d379d8 100644 --- a/ghcide/src/Development/IDE/Plugin/Completions.hs +++ b/ghcide/src/Development/IDE/Plugin/Completions.hs @@ -106,8 +106,13 @@ produceCompletions recorder = do -- Drop any explicit imports in ImportDecl if not hidden dropListFromImportDecl :: LImportDecl GhcPs -> LImportDecl GhcPs dropListFromImportDecl iDecl = let +#if MIN_VERSION_ghc(9,5,0) + f d@ImportDecl {ideclImportList} = case ideclImportList of + Just (Exactly, _) -> d {ideclImportList=Nothing} +#else f d@ImportDecl {ideclHiding} = case ideclHiding of Just (False, _) -> d {ideclHiding=Nothing} +#endif -- if hiding or Nothing just return d _ -> d f x = x diff --git a/ghcide/src/Development/IDE/Plugin/Completions/Logic.hs b/ghcide/src/Development/IDE/Plugin/Completions/Logic.hs index 92a4ea03209..345bf5f53d4 100644 --- a/ghcide/src/Development/IDE/Plugin/Completions/Logic.hs +++ b/ghcide/src/Development/IDE/Plugin/Completions/Logic.hs @@ -74,6 +74,10 @@ import Development.IDE import Development.IDE.Spans.AtPoint (pointCommand) +#if MIN_VERSION_ghc(9,5,0) +import Language.Haskell.Syntax.Basic +#endif + -- Chunk size used for parallelizing fuzzy matching chunkSize :: Int chunkSize = 1000 @@ -137,17 +141,25 @@ getCContext pos pm importGo :: GHC.LImportDecl GhcPs -> Maybe Context importGo (L (locA -> r) impDecl) | pos `isInsideSrcSpan` r - = importInline importModuleName (fmap (fmap reLoc) $ ideclHiding impDecl) + = importInline importModuleName (fmap (fmap reLoc) $ ideclImportList impDecl) <|> Just (ImportContext importModuleName) | otherwise = Nothing where importModuleName = moduleNameString $ unLoc $ ideclName impDecl - importInline :: String -> Maybe (Bool, GHC.Located [LIE GhcPs]) -> Maybe Context + -- importInline :: String -> Maybe (Bool, GHC.Located [LIE GhcPs]) -> Maybe Context +#if MIN_VERSION_ghc(9,5,0) + importInline modName (Just (EverythingBut, L r _)) +#else importInline modName (Just (True, L r _)) +#endif | pos `isInsideSrcSpan` r = Just $ ImportHidingContext modName | otherwise = Nothing +#if MIN_VERSION_ghc(9,5,0) + importInline modName (Just (Exactly, L r _)) +#else importInline modName (Just (False, L r _)) +#endif | pos `isInsideSrcSpan` r = Just $ ImportListContext modName | otherwise = Nothing importInline _ _ = Nothing @@ -383,7 +395,7 @@ cacheDataProducer uri visibleMods curMod globalEnv inScopeEnv limports = | isDataConName n , Just flds <- Map.lookup parent fieldMap , not (null flds) -> - [mkRecordSnippetCompItem uri mbParent (printOutputable originName) (map (T.pack . unpackFS) flds) (ImportedFrom mn) imp'] + [mkRecordSnippetCompItem uri mbParent (printOutputable originName) (map (T.pack . unpackFS . field_label) flds) (ImportedFrom mn) imp'] _ -> [] in mkNameCompItem uri mbParent originName (ImportedFrom mn) Nothing imp' (nameModule_maybe n) @@ -466,7 +478,7 @@ findRecordCompl uri mn DataDecl {tcdLName, tcdDataDefn} = result where result = [mkRecordSnippetCompItem uri (Just $ printOutputable $ unLoc tcdLName) (printOutputable . unLoc $ con_name) field_labels mn Nothing - | ConDeclH98{..} <- unLoc <$> dd_cons tcdDataDefn + | ConDeclH98{..} <- unLoc <$> (extract_cons $ dd_cons tcdDataDefn) , Just con_details <- [getFlds con_args] , let field_names = concatMap extract con_details , let field_labels = printOutputable <$> field_names @@ -498,6 +510,13 @@ findRecordCompl uri mn DataDecl {tcdLName, tcdDataDefn} = result extract _ = [] findRecordCompl _ _ _ = [] +#if MIN_VERSION_ghc(9,5,0) +extract_cons (NewTypeCon x) = [x] +extract_cons (DataTypeCons _ xs) = xs +#else +extract_cons = id +#endif + toggleSnippets :: ClientCapabilities -> CompletionsConfig -> CompletionItem -> CompletionItem toggleSnippets ClientCapabilities {_textDocument} CompletionsConfig{..} = removeSnippetsWhen (not $ enableSnippets && supported) diff --git a/ghcide/src/Development/IDE/Spans/Common.hs b/ghcide/src/Development/IDE/Spans/Common.hs index 9ae06659982..2ec1e98e94e 100644 --- a/ghcide/src/Development/IDE/Spans/Common.hs +++ b/ghcide/src/Development/IDE/Spans/Common.hs @@ -34,7 +34,11 @@ type DocMap = NameEnv SpanDoc type KindMap = NameEnv TyThing -- | Shows IEWrappedName, without any modifier, qualifier or unique identifier. +#if MIN_VERSION_ghc(9,5,0) +unqualIEWrapName :: IEWrappedName GhcPs -> T.Text +#else unqualIEWrapName :: IEWrappedName RdrName -> T.Text +#endif unqualIEWrapName = printOutputable . rdrNameOcc . ieWrappedName -- From haskell-ide-engine/src/Haskell/Ide/Engine/Support/HieExtras.hs diff --git a/ghcide/src/Development/IDE/Types/Exports.hs b/ghcide/src/Development/IDE/Types/Exports.hs index d61105801c8..4dd7d10a8cb 100644 --- a/ghcide/src/Development/IDE/Types/Exports.hs +++ b/ghcide/src/Development/IDE/Types/Exports.hs @@ -51,9 +51,9 @@ instance NFData ExportsMap where instance Show ExportsMap where show (ExportsMap occs mods) = unwords [ "ExportsMap { getExportsMap =" - , printWithoutUniques $ mapOccEnv (text . show) occs + , printWithoutUniques $ mapOccEnv (text @SDoc . show) occs , "getModuleExportsMap =" - , printWithoutUniques $ mapUFM (text . show) mods + , printWithoutUniques $ mapUFM (text @SDoc . show) mods , "}" ] diff --git a/hie-compat/hie-compat.cabal b/hie-compat/hie-compat.cabal index 6e3d829d95e..64a2a15029e 100644 --- a/hie-compat/hie-compat.cabal +++ b/hie-compat/hie-compat.cabal @@ -52,5 +52,5 @@ library hs-source-dirs: src-ghc90 src-reexport-ghc9 if (impl(ghc >= 9.2) && impl(ghc < 9.3)) hs-source-dirs: src-ghc92 src-reexport-ghc9 - if (impl(ghc >= 9.4) && impl(ghc < 9.5)) + if (impl(ghc >= 9.4) && impl(ghc < 9.7)) hs-source-dirs: src-reexport-ghc92