ghcide 1.9.1.0 → 1.10.0.0
raw patch · 34 files changed
+757/−233 lines, 34 filesdep −hsloggerdep ~hie-biosdep ~hiedbdep ~prettyprinterPVP ok
version bump matches the API change (PVP)
Dependencies removed: hslogger
Dependency ranges changed: hie-bios, hiedb, prettyprinter
API changes (from Hackage documentation)
- Development.IDE: priorityToHsLoggerPriority :: Priority -> Priority
- Development.IDE.GHC.Compat.Outputable: mkPrintUnqualified :: UnitEnv -> GlobalRdrEnv -> PrintUnqualified
- Development.IDE.Types.Logger: priorityToHsLoggerPriority :: Priority -> Priority
+ Development.IDE: GHC96 :: GhcVersion
+ Development.IDE: makeDefaultHandleRecorder :: MonadIO m => Maybe [LoggingColumn] -> Lock -> Handle -> m (Recorder (WithPriority (Doc a)))
+ Development.IDE.Core.Actions: lookupMod :: HieDbWriter -> FilePath -> ModuleName -> Unit -> Bool -> MaybeT IdeAction Uri
+ Development.IDE.Core.Rules: currentLinkables :: Action (ModuleEnv UTCTime)
+ Development.IDE.Core.Shake: instance GHC.Base.Semigroup (m a) => GHC.Base.Semigroup (Control.Monad.Trans.Reader.ReaderT r m a)
+ Development.IDE.Core.Shake: instance GHC.Base.Semigroup a => GHC.Base.Semigroup (Development.IDE.Core.Shake.IdeAction a)
+ Development.IDE.GHC.Compat: GHC96 :: GhcVersion
+ Development.IDE.GHC.Compat: extract_cons :: a -> a
+ Development.IDE.GHC.Compat: loadModulesHome :: [HomeModInfo] -> HscEnv -> HscEnv
+ Development.IDE.GHC.Compat: recDotDot :: HsRecFields (GhcPass p) arg -> Maybe Int
+ Development.IDE.GHC.Compat.Core: emptyHomeModInfoLinkable :: Maybe Linkable
+ Development.IDE.GHC.Compat.Core: field_label :: a -> a
+ Development.IDE.GHC.Compat.Core: homeModInfoByteCode :: HomeModInfo -> Maybe Linkable
+ Development.IDE.GHC.Compat.Core: homeModInfoObject :: HomeModInfo -> Maybe Linkable
+ Development.IDE.GHC.Compat.Core: justBytecode :: Linkable -> Maybe Linkable
+ Development.IDE.GHC.Compat.Core: justObjects :: Linkable -> Maybe Linkable
+ Development.IDE.GHC.Compat.Core: mkCgInteractiveGuts :: CgGuts -> CgGuts
+ Development.IDE.GHC.Compat.Outputable: SourceError :: ErrorMessages -> SourceError
+ Development.IDE.GHC.Compat.Outputable: newtype SourceError
+ Development.IDE.GHC.Compat.Outputable: textDoc :: String -> SDoc
+ Development.IDE.GHC.CoreFile: occNamePrefixes :: [Text]
+ Development.IDE.Spans.AtPoint: nameToLocation :: MonadIO m => WithHieDb -> LookupModule m -> Name -> m (Maybe [Location])
+ Development.IDE.Spans.AtPoint: type LookupModule m = FilePath -> ModuleName -> Unit -> Bool -> MaybeT m Uri
+ Development.IDE.Types.Logger: makeDefaultHandleRecorder :: MonadIO m => Maybe [LoggingColumn] -> Lock -> Handle -> m (Recorder (WithPriority (Doc a)))
- Development.IDE: makeDefaultStderrRecorder :: MonadIO m => Maybe [LoggingColumn] -> Priority -> m (Recorder (WithPriority (Doc a)))
+ Development.IDE: makeDefaultStderrRecorder :: MonadIO m => Maybe [LoggingColumn] -> m (Recorder (WithPriority (Doc a)))
- Development.IDE: withDefaultRecorder :: MonadUnliftIO m => Maybe FilePath -> Maybe [LoggingColumn] -> Priority -> (Recorder (WithPriority (Doc d)) -> m a) -> m a
+ Development.IDE: withDefaultRecorder :: MonadUnliftIO m => Maybe FilePath -> Maybe [LoggingColumn] -> (Recorder (WithPriority (Doc d)) -> m a) -> m a
- Development.IDE.Types.Logger: makeDefaultStderrRecorder :: MonadIO m => Maybe [LoggingColumn] -> Priority -> m (Recorder (WithPriority (Doc a)))
+ Development.IDE.Types.Logger: makeDefaultStderrRecorder :: MonadIO m => Maybe [LoggingColumn] -> m (Recorder (WithPriority (Doc a)))
- Development.IDE.Types.Logger: withDefaultRecorder :: MonadUnliftIO m => Maybe FilePath -> Maybe [LoggingColumn] -> Priority -> (Recorder (WithPriority (Doc d)) -> m a) -> m a
+ Development.IDE.Types.Logger: withDefaultRecorder :: MonadUnliftIO m => Maybe FilePath -> Maybe [LoggingColumn] -> (Recorder (WithPriority (Doc d)) -> m a) -> m a
Files
- exe/Main.hs +2/−2
- ghcide.cabal +4/−5
- session-loader/Development/IDE/Session.hs +2/−2
- src/Development/IDE/Core/Actions.hs +1/−0
- src/Development/IDE/Core/Compile.hs +47/−47
- src/Development/IDE/Core/Preprocessor.hs +2/−2
- src/Development/IDE/Core/Rules.hs +8/−3
- src/Development/IDE/Core/Shake.hs +10/−3
- src/Development/IDE/GHC/CPP.hs +24/−5
- src/Development/IDE/GHC/Compat.hs +84/−3
- src/Development/IDE/GHC/Compat/Core.hs +44/−2
- src/Development/IDE/GHC/Compat/Env.hs +10/−2
- src/Development/IDE/GHC/Compat/Logger.hs +4/−0
- src/Development/IDE/GHC/Compat/Outputable.hs +35/−4
- src/Development/IDE/GHC/Compat/Parser.hs +4/−0
- src/Development/IDE/GHC/Compat/Units.hs +2/−1
- src/Development/IDE/GHC/Compat/Util.hs +5/−2
- src/Development/IDE/GHC/CoreFile.hs +59/−11
- src/Development/IDE/GHC/Orphans.hs +15/−1
- src/Development/IDE/LSP/Outline.hs +6/−3
- src/Development/IDE/Plugin/Completions.hs +5/−0
- src/Development/IDE/Plugin/Completions/Logic.hs +21/−47
- src/Development/IDE/Spans/AtPoint.hs +13/−2
- src/Development/IDE/Spans/Common.hs +4/−0
- src/Development/IDE/Types/Exports.hs +2/−2
- src/Development/IDE/Types/Logger.hs +9/−67
- test/data/hover/GotoHover.hs +4/−0
- test/data/multi/a/a.cabal +1/−1
- test/data/multi/cabal.project +2/−0
- test/data/multi/dist-newstyle/build/x86_64-linux/ghc-9.4.0.20220623/a-1.0.0/build/autogen/Paths_a.hs +74/−0
- test/data/multi/dist-newstyle/build/x86_64-linux/ghc-9.4.0.20220623/a-1.0.0/t/a-test/build/a-test/autogen/Paths_a.hs +74/−0
- test/data/multi/dist-newstyle/build/x86_64-linux/ghc-9.4.0.20220623/b-1.0.0/build/autogen/Paths_b.hs +74/−0
- test/data/multi/dist-newstyle/build/x86_64-linux/ghc-9.4.0.20220623/c-1.0.0/build/autogen/Paths_c.hs +74/−0
- test/exe/Main.hs +32/−16
exe/Main.hs view
@@ -77,7 +77,7 @@ -- stderr recorder just for plugin cli commands pluginCliRecorder <- cmapWithPrio pretty- <$> makeDefaultStderrRecorder (Just [PriorityColumn, DataColumn]) Info+ <$> makeDefaultStderrRecorder (Just [PriorityColumn, DataColumn]) let hlsPlugins = pluginDescToIdePlugins (GhcIde.descriptors (cmapWithPrio LogGhcIde pluginCliRecorder)) -- WARNING: If you write to stdout before runLanguageServer@@ -94,7 +94,7 @@ let minPriority = if argsVerbose then Debug else Info - docWithPriorityRecorder <- makeDefaultStderrRecorder (Just [PriorityColumn, DataColumn]) minPriority+ docWithPriorityRecorder <- makeDefaultStderrRecorder (Just [PriorityColumn, DataColumn]) (lspLogRecorder, cb1) <- Logger.withBacklog Logger.lspClientLogRecorder (lspMessageRecorder, cb2) <- Logger.withBacklog Logger.lspClientMessageRecorder
ghcide.cabal view
@@ -2,7 +2,7 @@ build-type: Simple category: Development name: ghcide-version: 1.9.1.0+version: 1.10.0.0 license: Apache-2.0 license-file: LICENSE author: Digital Asset and Ghcide contributors@@ -68,14 +68,14 @@ hls-plugin-api ^>= 1.6, lens, list-t,- hiedb == 0.4.2.*,+ hiedb == 0.4.3.*, lsp-types ^>= 1.6.0.0, lsp ^>= 1.6.0.0 , mtl, optparse-applicative, parallel, prettyprinter-ansi-terminal,- prettyprinter >= 1.6,+ prettyprinter >= 1.7, random, regex-tdfa >= 1.3.1.0, text-rope,@@ -91,7 +91,6 @@ transformers, unordered-containers >= 0.2.10.0, vector,- hslogger, Diff ^>=0.4.0, vector, opentelemetry >=0.6.1,@@ -103,7 +102,7 @@ ghc-check >=0.5.0.8, ghc-paths, cryptohash-sha1 >=0.11.100 && <0.12,- hie-bios ^>= 0.11.0,+ hie-bios == 0.12.0, -- implicit-hie 0.1.3.0 introduced an unexpected behavioral change. -- https://github.com/Avi-D-coder/implicit-hie/issues/50 -- to make sure ghcide behaves in a desirable way, we put implicit-hie
session-loader/Development/IDE/Session.hs view
@@ -262,7 +262,7 @@ let log = logWith recorder hieYaml <- findCradle def rootDir cradle <- loadCradle def hieYaml rootDir- libDirRes <- getRuntimeGhcLibDir cradle+ libDirRes <- getRuntimeGhcLibDir (toCologActionWithPrio (cmapWithPrio LogHieBios recorder)) cradle case libDirRes of CradleSuccess libdir -> pure $ Just $ LibDir libdir CradleFail err -> do@@ -725,7 +725,7 @@ case cradleRes of CradleSuccess r -> do -- Now get the GHC lib dir- libDirRes <- getRuntimeGhcLibDir cradle+ libDirRes <- getRuntimeGhcLibDir logger cradle case libDirRes of -- This is the successful path CradleSuccess libDir -> pure (Right (r, libDir))
src/Development/IDE/Core/Actions.hs view
@@ -10,6 +10,7 @@ , useNoFileE , usesE , workspaceSymbols+, lookupMod ) where import Control.Monad.Reader
src/Development/IDE/Core/Compile.hs view
@@ -36,6 +36,7 @@ , 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,11 @@ 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+#endif+ -- | Given a string buffer, return the string (after preprocessing) and the 'ParsedModule'. parseModule :: IdeOptions@@ -467,7 +473,11 @@ 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 +492,19 @@ 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 +522,7 @@ 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 +545,23 @@ 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 +569,13 @@ #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 +700,7 @@ 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]@@ -1008,28 +1025,6 @@ . (("Error during " ++ T.unpack source) ++) . show @SomeException ] --- | Load modules, quickly. Input doesn't need to be desugared.--- A module must be loaded before dependent modules can be typechecked.--- This variant of loadModuleHome will *never* cause recompilation, it just--- modifies the session.--- The order modules are loaded is important when there are hs-boot files.--- In particular you should make sure to load the .hs version of a file after the--- .hs-boot version.-loadModulesHome- :: [HomeModInfo]- -> HscEnv- -> HscEnv-loadModulesHome mod_infos e =-#if MIN_VERSION_ghc(9,3,0)- hscUpdateHUG (\hug -> foldl' (flip addHomeModInfoToHug) hug mod_infos) (e { hsc_type_env_vars = emptyKnotVars })-#else- let !new_modules = addListToHpt (hsc_HPT e) [(mod_name x, x) | x <- mod_infos]- in e { hsc_HPT = new_modules- , hsc_type_env_var = Nothing- }- where- mod_name = moduleName . mi_module . hm_iface-#endif -- Merge the HPTs, module graphs and FinderCaches -- See Note [GhcSessionDeps] in Development.IDE.Core.Rules@@ -1242,7 +1237,9 @@ => 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 +1571,13 @@ 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 {@@ -1594,7 +1591,10 @@ -- Implicit binds aren't saved, so we need to regenerate them ourselves. let implicit_binds = concatMap getImplicitBinds tyCons tyCons = typeEnvTyCons (md_types details)-#if MIN_VERSION_ghc(9,3,0)+#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 []+#elif MIN_VERSION_ghc(9,3,0) pure $ CgGuts this_mod tyCons (implicit_binds ++ core_binds) [] NoStubs [] mempty (emptyHpcInfo False) Nothing [] #else pure $ CgGuts this_mod tyCons (implicit_binds ++ core_binds) NoStubs [] [] (emptyHpcInfo False) Nothing []@@ -1604,9 +1604,9 @@ 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
src/Development/IDE/Core/Preprocessor.hs view
@@ -204,7 +204,7 @@ -- Happy case, file is not modified, so run CPP on it in-place -- which also makes things like relative #include files work -- and means location information is correct- doCpp env1 True filename out+ doCpp env1 filename out liftIO $ Util.hGetStringBuffer out Just contents -> do@@ -218,7 +218,7 @@ let inp = dir </> "___GHCIDE_MAGIC___" withBinaryFile inp WriteMode $ \h -> hPutStringBuffer h contents- doCpp env2 True inp out+ doCpp env2 inp out -- Fix up the filename in lines like: -- # 1 "C:/Temp/extra-dir-914611385186/___GHCIDE_MAGIC___"
src/Development/IDE/Core/Rules.hs view
@@ -57,11 +57,13 @@ typeCheckRuleDefinition, getRebuildCount, getSourceFileSource,+ currentLinkables, GhcSessionDepsConfig(..), Log(..), DisplayTHWarning(..), ) where +import Control.Applicative import Control.Concurrent.Async (concurrently) import Control.Concurrent.Strict import Control.DeepSeq@@ -160,6 +162,9 @@ 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 +780,7 @@ 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 +1104,10 @@ 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
src/Development/IDE/Core/Shake.hs view
@@ -307,13 +307,17 @@ getShakeExtras :: Action ShakeExtras getShakeExtras = do+ -- Will fail the action with a pattern match failure, but be caught Just x <- getShakeExtra @ShakeExtras return x getShakeExtrasRules :: Rules ShakeExtras getShakeExtrasRules = do- Just x <- getShakeExtraRules @ShakeExtras- return x+ mExtras <- getShakeExtraRules @ShakeExtras+ case mExtras of+ Just x -> return x+ -- This will actually crash HLS+ Nothing -> liftIO $ fail "missing ShakeExtras" -- | Returns the client configuration, creating a build dependency. -- You should always use this function when accessing client configuration@@ -978,7 +982,10 @@ -- -- Run via 'runIdeAction'. newtype IdeAction a = IdeAction { runIdeActionT :: (ReaderT ShakeExtras IO) a }- deriving newtype (MonadReader ShakeExtras, MonadIO, Functor, Applicative, Monad)+ deriving newtype (MonadReader ShakeExtras, MonadIO, Functor, Applicative, Monad, Semigroup)++-- https://hub.darcs.net/ross/transformers/issue/86+deriving instance (Semigroup (m a)) => Semigroup (ReaderT r m a) runIdeAction :: String -> ShakeExtras -> IdeAction a -> IO a runIdeAction _herald s i = runReaderT (runIdeActionT i) s
src/Development/IDE/GHC/CPP.hs view
@@ -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@@ -26,6 +27,11 @@ import qualified DriverPipeline as Pipeline import ToolSettings #endif++#if MIN_VERSION_ghc(9,5,0)+import qualified GHC.SysTools.Cpp as Pipeline+#endif+ #if MIN_VERSION_ghc(9,3,0) import qualified GHC.Driver.Pipeline.Execute as Pipeline #endif@@ -39,11 +45,24 @@ fingerprintStrings ss = fingerprintFingerprints $ map fingerprintString ss alterToolSettings f dynFlags = dynFlags { toolSettings = f (toolSettings dynFlags) } -doCpp :: HscEnv -> Bool -> FilePath -> FilePath -> IO ()-doCpp env raw input_fn output_fn =-#if 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+doCpp :: HscEnv -> FilePath -> FilePath -> IO ()+doCpp env input_fn output_fn =+ -- See GHC commit a2f53ac8d968723417baadfab5be36a020ea6850+ -- this function/Pipeline.doCpp previously had a raw parameter+ -- always set to True that corresponded to these settings++#if MIN_VERSION_ghc(9,5,0)+ let cpp_opts = Pipeline.CppOpts+ { cppUseCc = False+ , cppLinePragmas = True+ } in #else- Pipeline.doCpp (hsc_dflags env) raw input_fn output_fn+ let cpp_opts = True in+#endif++#if MIN_VERSION_ghc(9,2,0)+ Pipeline.doCpp (hsc_logger env) (hsc_tmpfs env) (hsc_dflags env) (hsc_unit_env env) cpp_opts input_fn output_fn+#else+ Pipeline.doCpp (hsc_dflags env) cpp_opts input_fn output_fn #endif
src/Development/IDE/GHC/Compat.hs view
@@ -104,6 +104,7 @@ icInteractiveModule, HomePackageTable, lookupHpt,+ loadModulesHome, #if MIN_VERSION_ghc(9,3,0) Dependencies(dep_direct_mods), #else@@ -134,6 +135,11 @@ coreExprToBCOs, linkExpr, #endif+ extract_cons,+ recDotDot,+#if MIN_VERSION_ghc(9,5,0)+ XModulePs(..),+#endif ) where import Data.Bifunctor@@ -156,7 +162,15 @@ #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 +323,11 @@ 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 +360,13 @@ 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,8 +375,14 @@ #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 +409,21 @@ 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@@ -574,13 +615,16 @@ | GHC90 | GHC92 | GHC94+ | GHC96 deriving (Eq, Ord, Show) ghcVersionStr :: String ghcVersionStr = VERSION_ghc ghcVersion :: GhcVersion-#if MIN_VERSION_GLASGOW_HASKELL(9,4,0,0)+#if MIN_VERSION_GLASGOW_HASKELL(9,6,0,0)+ghcVersion = GHC96+#elif MIN_VERSION_GLASGOW_HASKELL(9,4,0,0) ghcVersion = GHC94 #elif MIN_VERSION_GLASGOW_HASKELL(9,2,0,0) ghcVersion = GHC92@@ -652,4 +696,41 @@ (line_end, col_end) = max (srcSpanEndLine span1, srcSpanEndCol span1) (srcSpanEndLine span2, srcSpanEndCol span2) file = srcSpanFile span1+#endif++-- | Load modules, quickly. Input doesn't need to be desugared.+-- A module must be loaded before dependent modules can be typechecked.+-- This variant of loadModuleHome will *never* cause recompilation, it just+-- modifies the session.+-- The order modules are loaded is important when there are hs-boot files.+-- In particular you should make sure to load the .hs version of a file after the+-- .hs-boot version.+loadModulesHome+ :: [HomeModInfo]+ -> HscEnv+ -> HscEnv+loadModulesHome mod_infos e =+#if MIN_VERSION_ghc(9,3,0)+ hscUpdateHUG (\hug -> foldl' (flip addHomeModInfoToHug) hug mod_infos) (e { hsc_type_env_vars = emptyKnotVars })+#else+ let !new_modules = addListToHpt (hsc_HPT e) [(mod_name x, x) | x <- mod_infos]+ in e { hsc_HPT = new_modules+ , hsc_type_env_var = Nothing+ }+ where+ mod_name = moduleName . mi_module . hm_iface+#endif++recDotDot :: HsRecFields (GhcPass p) arg -> Maybe Int+recDotDot x =+#if MIN_VERSION_ghc(9,5,0)+ unRecFieldsDotDot <$>+#endif+ unLoc <$> rec_dotdot x++#if MIN_VERSION_ghc(9,5,0)+extract_cons (NewTypeCon x) = [x]+extract_cons (DataTypeCons _ xs) = xs+#else+extract_cons = id #endif
src/Development/IDE/GHC/Compat/Core.hs view
@@ -263,7 +263,7 @@ SrcLoc.noSrcSpan, SrcLoc.noSrcLoc, SrcLoc.noLoc,- SrcLoc.mapLoc,+ mapLoc, -- * Finder FindResult(..), mkHomeModLocation,@@ -447,6 +447,7 @@ -- * Syntax re-exports #if MIN_VERSION_ghc(9,0,0) module GHC.Hs,+ module GHC.Hs.Binds, module GHC.Parser, module GHC.Parser.Header, module GHC.Parser.Lexer,@@ -486,6 +487,15 @@ Extension(..), #endif UniqFM,+ mkCgInteractiveGuts,+ justBytecode,+ justObjects,+ emptyHomeModInfoLinkable,+ homeModInfoByteCode,+ homeModInfoObject,+# if !MIN_VERSION_ghc(9,5,0)+ field_label,+#endif ) where import qualified GHC@@ -786,6 +796,7 @@ -- (until the CPP extension is actually needed). import GHC.LanguageExtensions.Type hiding (Cpp) +import GHC.Hs.Binds mkHomeModLocation :: DynFlags -> ModuleName -> FilePath -> IO Module.ModLocation #if MIN_VERSION_ghc(9,3,0)@@ -872,7 +883,7 @@ pattern FunTy :: Type -> Type -> Type pattern FunTy arg res <- TyCoRep.FunTy {ft_arg = arg, ft_res = res} -#if MIN_VERSION_ghc(9,0,0)+#if MIN_VERSION_ghc(8,10,0) -- type HasSrcSpan x a = (GenLocated SrcSpan a ~ x) -- type HasSrcSpan x = () :: Constraint @@ -1180,4 +1191,35 @@ 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+#else+mapLoc :: (a -> b) -> SrcLoc.GenLocated l a -> SrcLoc.GenLocated l b+mapLoc = SrcLoc.mapLoc+#endif+++#if !MIN_VERSION_ghc(9,5,0)+mkCgInteractiveGuts :: CgGuts -> CgGuts+mkCgInteractiveGuts = id++emptyHomeModInfoLinkable :: Maybe Linkable+emptyHomeModInfoLinkable = Nothing++justBytecode :: Linkable -> Maybe Linkable+justBytecode = Just++justObjects :: Linkable -> Maybe Linkable+justObjects = Just++homeModInfoByteCode, homeModInfoObject :: HomeModInfo -> Maybe Linkable+homeModInfoByteCode = hm_linkable+homeModInfoObject = hm_linkable++field_label :: a -> a+field_label = id #endif
src/Development/IDE/GHC/Compat/Env.hs view
@@ -82,7 +82,11 @@ #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 @@ 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 @@ 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
src/Development/IDE/GHC/Compat/Logger.hs view
@@ -49,7 +49,11 @@ -- 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
src/Development/IDE/GHC/Compat/Outputable.hs view
@@ -9,7 +9,6 @@ ppr, pprPanic, text, vcat, (<+>), ($$), empty, hang, nest, punctuate, printSDocQualifiedUnsafe, printWithoutUniques,- mkPrintUnqualified, mkPrintUnqualifiedDefault, PrintUnqualified(..), defaultUserStyle,@@ -17,9 +16,20 @@ -- * Parser errors PsWarning, PsError,+#if MIN_VERSION_ghc(9,5,0)+ defaultDiagnosticOpts,+ GhcMessage,+#endif #if MIN_VERSION_ghc(9,3,0) DiagnosticReason(..), renderDiagnosticMessageWithHints,+ pprMsgEnvelopeBagWithLoc,+ Error.getMessages,+ renderWithContext,+ defaultSDocContext,+ errMsgDiagnostic,+ unDecorated,+ diagnosticMessage, #else pprWarning, pprError,@@ -29,12 +39,14 @@ MsgEnvelope, ErrMsg, WarnMsg,+ SourceError(..), errMsgSpan, errMsgSeverity, formatErrorWithQual, mkWarnMsg, mkSrcErr, srcErrorMessages,+ textDoc, ) where @@ -80,12 +92,19 @@ import qualified Outputable as Out import SrcLoc #endif+#if MIN_VERSION_ghc(9,5,0)+import GHC.Driver.Errors.Types (GhcMessage)+#endif #if MIN_VERSION_ghc(9,3,0) import Data.Maybe import GHC.Driver.Config.Diagnostic import GHC.Utils.Logger #endif +#if MIN_VERSION_ghc(9,5,0)+type PrintUnqualified = NamePprCtx+#endif+ -- | A compatible function to print `Outputable` instances -- without unique symbols. --@@ -203,7 +222,11 @@ 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,9 +235,14 @@ #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) mkWarnMsg :: DynFlags -> Maybe DiagnosticReason -> b -> SrcSpan -> PrintUnqualified -> SDoc -> MsgEnvelope DecoratedSDoc@@ -235,3 +263,6 @@ #else defaultUserStyle = Out.defaultUserStyle unsafeGlobalDynFlags #endif++textDoc :: String -> SDoc+textDoc = text
src/Development/IDE/GHC/Compat/Parser.hs view
@@ -120,7 +120,11 @@ #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
src/Development/IDE/GHC/Compat/Units.hs view
@@ -99,6 +99,7 @@ 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 @@ #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
src/Development/IDE/GHC/Compat/Util.hs view
@@ -24,9 +24,7 @@ LBooleanFormula, BooleanFormula(..), -- * OverridingBool-#if !MIN_VERSION_ghc(9,3,0) OverridingBool(..),-#endif -- * Maybes MaybeErr(..), orElse,@@ -103,6 +101,11 @@ import Unique import Util #endif++#if MIN_VERSION_ghc(9,3,0)+import GHC.Data.Bool+#endif+ #if !MIN_VERSION_ghc(9,0,0) type MonadCatch = Exception.ExceptionMonad
src/Development/IDE/GHC/CoreFile.hs view
@@ -10,7 +10,8 @@ , typecheckCoreFile , readBinCoreFile , writeBinCoreFile- , getImplicitBinds) where+ , getImplicitBinds+ , occNamePrefixes) where import Control.Monad import Control.Monad.IO.Class@@ -18,6 +19,7 @@ import Data.IORef import Data.List (isPrefixOf) import Data.Maybe+import qualified Data.Text as T import GHC.Fingerprint import Development.IDE.GHC.Compat@@ -134,8 +136,12 @@ :: Fingerprint -- ^ Hash of the interface this was generated from -> CgGuts -> CoreFile-codeGutsToCoreFile hash CgGuts{..} = CoreFile (map (toIfaceTopBind cg_module) $ filter isNotImplictBind cg_binds) hash-+#if MIN_VERSION_ghc(9,5,0)+-- In GHC 9.6, implicit binds are tidied and part of core binds+codeGutsToCoreFile hash CgGuts{..} = CoreFile (map (toIfaceTopBind1 cg_module) cg_binds) hash+#else+codeGutsToCoreFile hash CgGuts{..} = CoreFile (map (toIfaceTopBind1 cg_module) $ filter isNotImplictBind cg_binds) hash+#endif -- | Implicit binds can be generated from the interface and are not tidied, -- so we must filter them out isNotImplictBind :: CoreBind -> Bool@@ -163,21 +169,21 @@ 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 +205,9 @@ 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@@ -228,3 +234,45 @@ tc_iface_bindings (TopIfaceRec vs) = do vs' <- traverse (\(v, e) -> (,) <$> pure v <*> tcIfaceExpr e) vs pure $ Rec vs'++-- | Prefixes that can occur in a GHC OccName+occNamePrefixes :: [T.Text]+occNamePrefixes =+ [+ -- long ones+ "$con2tag_"+ , "$tag2con_"+ , "$maxtag_"++ -- four chars+ , "$sel:"+ , "$tc'"++ -- three chars+ , "$dm"+ , "$co"+ , "$tc"+ , "$cp"+ , "$fx"++ -- two chars+ , "$W"+ , "$w"+ , "$m"+ , "$b"+ , "$c"+ , "$d"+ , "$i"+ , "$s"+ , "$f"+ , "$r"+ , "C:"+ , "N:"+ , "D:"+ , "$p"+ , "$L"+ , "$f"+ , "$t"+ , "$c"+ , "$m"+ ]
src/Development/IDE/GHC/Orphans.hs view
@@ -46,6 +46,9 @@ #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 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 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 (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@@ -220,5 +229,10 @@ rnf = rwhnf instance NFData NodeKey where+ rnf = rwhnf+#endif++#if MIN_VERSION_ghc(9,5,0)+instance NFData HomeModLinkable where rnf = rwhnf #endif
src/Development/IDE/LSP/Outline.hs view
@@ -11,6 +11,7 @@ import Control.Monad.IO.Class import Data.Functor+import Data.Foldable (toList) import Data.Generics hiding (Prefix) import Data.Maybe import qualified Data.Text as T@@ -30,7 +31,7 @@ TextDocumentIdentifier (TextDocumentIdentifier), type (|?) (InL), uriToFilePath) #if MIN_VERSION_ghc(9,2,0)-import Data.List.NonEmpty (nonEmpty, toList)+import Data.List.NonEmpty (nonEmpty) #endif moduleOutline@@ -111,7 +112,7 @@ #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 +292,7 @@ -- 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 +319,5 @@ -> ([LFieldOcc GhcPs]) get_flds flds = concatMap (cd_fld_names . unLoc) (unLoc flds) #endif++
src/Development/IDE/Plugin/Completions.hs view
@@ -106,8 +106,13 @@ -- 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
src/Development/IDE/Plugin/Completions/Logic.hs view
@@ -41,6 +41,7 @@ import Development.IDE.GHC.Compat hiding (ppr) import qualified Development.IDE.GHC.Compat as GHC import Development.IDE.GHC.Compat.Util+import Development.IDE.GHC.CoreFile (occNamePrefixes) import Development.IDE.GHC.Error import Development.IDE.GHC.Util import Development.IDE.Plugin.Completions.Types@@ -74,6 +75,10 @@ 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 +142,29 @@ importGo :: GHC.LImportDecl GhcPs -> Maybe Context importGo (L (locA -> r) impDecl) | pos `isInsideSrcSpan` r+#if MIN_VERSION_ghc(9,5,0)+ = importInline importModuleName (fmap (fmap reLoc) $ ideclImportList impDecl)+#else = importInline importModuleName (fmap (fmap reLoc) $ ideclHiding impDecl)+#endif <|> 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 +400,7 @@ | 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 +483,7 @@ 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@@ -767,50 +784,7 @@ -- TODO: Turn this into an alex lexer that discards prefixes as if they were whitespace. stripPrefix :: T.Text -> T.Text stripPrefix name = T.takeWhile (/=':') $ fromMaybe name $- getFirst $ foldMap (First . (`T.stripPrefix` name)) prefixes---- | Prefixes that can occur in a GHC OccName-prefixes :: [T.Text]-prefixes =- [- -- long ones- "$con2tag_"- , "$tag2con_"- , "$maxtag_"-- -- four chars- , "$sel:"- , "$tc'"-- -- three chars- , "$dm"- , "$co"- , "$tc"- , "$cp"- , "$fx"-- -- two chars- , "$W"- , "$w"- , "$m"- , "$b"- , "$c"- , "$d"- , "$i"- , "$s"- , "$f"- , "$r"- , "C:"- , "N:"- , "D:"- , "$p"- , "$L"- , "$f"- , "$t"- , "$c"- , "$m"- ]-+ getFirst $ foldMap (First . (`T.stripPrefix` name)) occNamePrefixes mkRecordSnippetCompItem :: Uri -> Maybe T.Text -> T.Text -> [T.Text] -> Provenance -> Maybe (LImportDecl GhcPs) -> CompItem mkRecordSnippetCompItem uri parent ctxStr compl importedFrom imp = r
src/Development/IDE/Spans/AtPoint.hs view
@@ -20,6 +20,8 @@ , getNamesAtPoint , toCurrentLocation , rowToLoc+ , nameToLocation+ , LookupModule ) where import Development.IDE.GHC.Error@@ -225,10 +227,19 @@ wrapHaskell x = "\n```haskell\n"<>x<>"\n```\n" info = nodeInfoH kind ast names = M.assocs $ nodeIdentifiers info+ -- Check for evidence bindings+ isInternal :: (Identifier, IdentifierDetails a) -> Bool+ isInternal (Right _, dets) =+#if MIN_VERSION_ghc(9,0,1)+ any isEvidenceContext $ identInfo dets+#else+ False+#endif+ isInternal (Left _, _) = False+ filteredNames = filter (not . isInternal) names types = nodeType info- prettyNames :: [T.Text]- prettyNames = map prettyName names+ prettyNames = map prettyName filteredNames prettyName (Right n, dets) = T.unlines $ wrapHaskell (printOutputable n <> maybe "" (" :: " <>) ((prettyType <$> identType dets) <|> maybeKind)) : maybeToList (pretty (definedAt n) (prettyPackageName n))
src/Development/IDE/Spans/Common.hs view
@@ -34,7 +34,11 @@ 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
src/Development/IDE/Types/Exports.hs view
@@ -51,9 +51,9 @@ instance Show ExportsMap where show (ExportsMap occs mods) = unwords [ "ExportsMap { getExportsMap ="- , printWithoutUniques $ mapOccEnv (text . show) occs+ , printWithoutUniques $ mapOccEnv (textDoc . show) occs , "getModuleExportsMap ="- , printWithoutUniques $ mapUFM (text . show) mods+ , printWithoutUniques $ mapUFM (textDoc . show) mods , "}" ]
src/Development/IDE/Types/Logger.hs view
@@ -19,7 +19,7 @@ , cfilter , withDefaultRecorder , makeDefaultStderrRecorder- , priorityToHsLoggerPriority+ , makeDefaultHandleRecorder , LoggingColumn(..) , cmapWithPrio , withBacklog@@ -39,8 +39,7 @@ readTVarIO, writeTBQueue, writeTVar) import Control.Exception (IOException)-import Control.Monad (forM_, unless, when,- (>=>))+import Control.Monad (unless, when, (>=>)) import Control.Monad.IO.Class (MonadIO (liftIO)) import Data.Foldable (for_) import Data.Functor.Contravariant (Contravariant (contramap))@@ -76,12 +75,7 @@ import System.IO (Handle, IOMode (AppendMode), hClose, hFlush,- hSetEncoding, openFile,- stderr, utf8)-import qualified System.Log.Formatter as HSL-import qualified System.Log.Handler as HSL-import qualified System.Log.Handler.Simple as HSL-import qualified System.Log.Logger as HsLogger+ openFile, stderr) import UnliftIO (MonadUnliftIO, displayException, finally, try)@@ -170,31 +164,24 @@ Recorder { logger_ = \text -> liftIO $ Text.hPutStrLn handle text *> hFlush handle } --- | Priority is actually for hslogger compatibility-makeDefaultStderrRecorder :: MonadIO m => Maybe [LoggingColumn] -> Priority -> m (Recorder (WithPriority (Doc a)))-makeDefaultStderrRecorder columns minPriority = do+makeDefaultStderrRecorder :: MonadIO m => Maybe [LoggingColumn] -> m (Recorder (WithPriority (Doc a)))+makeDefaultStderrRecorder columns = do lock <- liftIO newLock- makeDefaultHandleRecorder columns minPriority lock stderr+ makeDefaultHandleRecorder columns lock stderr -- | If no path given then use stderr, otherwise use file.--- Kinda complicated because we also need to setup `hslogger` for--- `hie-bios` log compatibility reasons. If `hie-bios` can be set to use our--- logger instead or if `hie-bios` doesn't use `hslogger` then `hslogger` can--- be removed completely. See `setupHsLogger` comment. withDefaultRecorder :: MonadUnliftIO m => Maybe FilePath -- ^ Log file path. `Nothing` uses stderr -> Maybe [LoggingColumn] -- ^ logging columns to display. `Nothing` uses `defaultLoggingColumns`- -> Priority- -- ^ min priority for hslogger compatibility -> (Recorder (WithPriority (Doc d)) -> m a) -- ^ action given a recorder -> m a-withDefaultRecorder path columns minPriority action = do+withDefaultRecorder path columns action = do lock <- liftIO newLock- let makeHandleRecorder = makeDefaultHandleRecorder columns minPriority lock+ let makeHandleRecorder = makeDefaultHandleRecorder columns lock case path of Nothing -> do recorder <- makeHandleRecorder stderr@@ -216,64 +203,19 @@ :: MonadIO m => Maybe [LoggingColumn] -- ^ built-in logging columns to display. Nothing uses the default- -> Priority- -- ^ min priority for hslogger compatibility -> Lock -- ^ lock to take when outputting to handle -> Handle -- ^ handle to output to -> m (Recorder (WithPriority (Doc a)))-makeDefaultHandleRecorder columns minPriority lock handle = do+makeDefaultHandleRecorder columns lock handle = do let Recorder{ logger_ } = textHandleRecorder handle let threadSafeRecorder = Recorder { logger_ = \msg -> liftIO $ withLock lock (logger_ msg) } let loggingColumns = fromMaybe defaultLoggingColumns columns let textWithPriorityRecorder = cmapIO (textWithPriorityToText loggingColumns) threadSafeRecorder- -- see `setupHsLogger` comment- liftIO $ setupHsLogger lock handle ["hls", "hie-bios"] (priorityToHsLoggerPriority minPriority) pure (cmap docToText textWithPriorityRecorder) where docToText = fmap (renderStrict . layoutPretty defaultLayoutOptions)--priorityToHsLoggerPriority :: Priority -> HsLogger.Priority-priorityToHsLoggerPriority = \case- Debug -> HsLogger.DEBUG- Info -> HsLogger.INFO- Warning -> HsLogger.WARNING- Error -> HsLogger.ERROR---- | The purpose of setting up `hslogger` at all is that `hie-bios` uses--- `hslogger` to output compilation logs. The easiest way to merge these logs--- with our log output is to setup an `hslogger` that uses the same handle--- and same lock as our loggers. That way the output from our loggers and--- `hie-bios` don't interleave strangely.--- It may be possible to have `hie-bios` use our logger by decorating the--- `Cradle.cradleOptsProg.runCradle` we get in the Cradle from--- `HieBios.findCradle`, but I remember trying that and something not good--- happened. I'd have to try it again to remember if that was a real issue.--- Once that is figured out or `hie-bios` doesn't use `hslogger`, then all--- references to `hslogger` can be removed entirely.-setupHsLogger :: Lock -> Handle -> [String] -> HsLogger.Priority -> IO ()-setupHsLogger lock handle extraLogNames level = do- hSetEncoding handle utf8-- logH <- HSL.streamHandler handle level-- let logHandle = logH- { HSL.writeFunc = \a s -> withLock lock $ HSL.writeFunc logH a s }- logFormatter = HSL.tfLogFormatter logDateFormat logFormat- logHandler = HSL.setFormatter logHandle logFormatter-- HsLogger.updateGlobalLogger HsLogger.rootLoggerName $ HsLogger.setHandlers ([] :: [HSL.GenericHandler Handle])- HsLogger.updateGlobalLogger "haskell-lsp" $ HsLogger.setHandlers [logHandler]- HsLogger.updateGlobalLogger "haskell-lsp" $ HsLogger.setLevel level-- -- Also route the additional log names to the same log- forM_ extraLogNames $ \logName -> do- HsLogger.updateGlobalLogger logName $ HsLogger.setHandlers [logHandler]- HsLogger.updateGlobalLogger logName $ HsLogger.setLevel level- where- logFormat = "$time [$tid] $prio $loggername:\t$msg"- logDateFormat = "%Y-%m-%d %H:%M:%S%Q" data LoggingColumn = TimeColumn
test/data/hover/GotoHover.hs view
@@ -64,3 +64,7 @@ hole2 :: a -> Maybe a hole2 = _++-- A comment above a type defnition with a deriving clause+data Example = Example+ deriving (Eq)
test/data/multi/a/a.cabal view
@@ -4,6 +4,6 @@ cabal-version: >= 1.2 library- build-depends: base, async+ build-depends: base, async >= 2.0 exposed-modules: A hs-source-dirs: .
test/data/multi/cabal.project view
@@ -1,1 +1,3 @@ packages: a b c++allow-newer: base
+ test/data/multi/dist-newstyle/build/x86_64-linux/ghc-9.4.0.20220623/a-1.0.0/build/autogen/Paths_a.hs view
@@ -0,0 +1,74 @@+{-# LANGUAGE CPP #-}+{-# LANGUAGE NoRebindableSyntax #-}+{-# OPTIONS_GHC -fno-warn-missing-import-lists #-}+{-# OPTIONS_GHC -w #-}+module Paths_a (+ version,+ getBinDir, getLibDir, getDynLibDir, getDataDir, getLibexecDir,+ getDataFileName, getSysconfDir+ ) where+++import qualified Control.Exception as Exception+import qualified Data.List as List+import Data.Version (Version(..))+import System.Environment (getEnv)+import Prelude+++#if defined(VERSION_base)++#if MIN_VERSION_base(4,0,0)+catchIO :: IO a -> (Exception.IOException -> IO a) -> IO a+#else+catchIO :: IO a -> (Exception.Exception -> IO a) -> IO a+#endif++#else+catchIO :: IO a -> (Exception.IOException -> IO a) -> IO a+#endif+catchIO = Exception.catch++version :: Version+version = Version [1,0,0] []++getDataFileName :: FilePath -> IO FilePath+getDataFileName name = do+ dir <- getDataDir+ return (dir `joinFileName` name)++getBinDir, getLibDir, getDynLibDir, getDataDir, getLibexecDir, getSysconfDir :: IO FilePath++++bindir, libdir, dynlibdir, datadir, libexecdir, sysconfdir :: FilePath+bindir = "/home/zubin/.cabal/bin"+libdir = "/home/zubin/.cabal/lib/x86_64-linux-ghc-9.4.0.20220623/a-1.0.0-inplace"+dynlibdir = "/home/zubin/.cabal/lib/x86_64-linux-ghc-9.4.0.20220623"+datadir = "/home/zubin/.cabal/share/x86_64-linux-ghc-9.4.0.20220623/a-1.0.0"+libexecdir = "/home/zubin/.cabal/libexec/x86_64-linux-ghc-9.4.0.20220623/a-1.0.0"+sysconfdir = "/home/zubin/.cabal/etc"++getBinDir = catchIO (getEnv "a_bindir") (\_ -> return bindir)+getLibDir = catchIO (getEnv "a_libdir") (\_ -> return libdir)+getDynLibDir = catchIO (getEnv "a_dynlibdir") (\_ -> return dynlibdir)+getDataDir = catchIO (getEnv "a_datadir") (\_ -> return datadir)+getLibexecDir = catchIO (getEnv "a_libexecdir") (\_ -> return libexecdir)+getSysconfDir = catchIO (getEnv "a_sysconfdir") (\_ -> return sysconfdir)+++++joinFileName :: String -> String -> FilePath+joinFileName "" fname = fname+joinFileName "." fname = fname+joinFileName dir "" = dir+joinFileName dir fname+ | isPathSeparator (List.last dir) = dir ++ fname+ | otherwise = dir ++ pathSeparator : fname++pathSeparator :: Char+pathSeparator = '/'++isPathSeparator :: Char -> Bool+isPathSeparator c = c == '/'
+ test/data/multi/dist-newstyle/build/x86_64-linux/ghc-9.4.0.20220623/a-1.0.0/t/a-test/build/a-test/autogen/Paths_a.hs view
@@ -0,0 +1,74 @@+{-# LANGUAGE CPP #-}+{-# LANGUAGE NoRebindableSyntax #-}+{-# OPTIONS_GHC -fno-warn-missing-import-lists #-}+{-# OPTIONS_GHC -w #-}+module Paths_a (+ version,+ getBinDir, getLibDir, getDynLibDir, getDataDir, getLibexecDir,+ getDataFileName, getSysconfDir+ ) where+++import qualified Control.Exception as Exception+import qualified Data.List as List+import Data.Version (Version(..))+import System.Environment (getEnv)+import Prelude+++#if defined(VERSION_base)++#if MIN_VERSION_base(4,0,0)+catchIO :: IO a -> (Exception.IOException -> IO a) -> IO a+#else+catchIO :: IO a -> (Exception.Exception -> IO a) -> IO a+#endif++#else+catchIO :: IO a -> (Exception.IOException -> IO a) -> IO a+#endif+catchIO = Exception.catch++version :: Version+version = Version [1,0,0] []++getDataFileName :: FilePath -> IO FilePath+getDataFileName name = do+ dir <- getDataDir+ return (dir `joinFileName` name)++getBinDir, getLibDir, getDynLibDir, getDataDir, getLibexecDir, getSysconfDir :: IO FilePath++++bindir, libdir, dynlibdir, datadir, libexecdir, sysconfdir :: FilePath+bindir = "/home/zubin/.cabal/bin"+libdir = "/home/zubin/.cabal/lib/x86_64-linux-ghc-9.4.0.20220623/a-1.0.0-inplace-a-test"+dynlibdir = "/home/zubin/.cabal/lib/x86_64-linux-ghc-9.4.0.20220623"+datadir = "/home/zubin/.cabal/share/x86_64-linux-ghc-9.4.0.20220623/a-1.0.0"+libexecdir = "/home/zubin/.cabal/libexec/x86_64-linux-ghc-9.4.0.20220623/a-1.0.0"+sysconfdir = "/home/zubin/.cabal/etc"++getBinDir = catchIO (getEnv "a_bindir") (\_ -> return bindir)+getLibDir = catchIO (getEnv "a_libdir") (\_ -> return libdir)+getDynLibDir = catchIO (getEnv "a_dynlibdir") (\_ -> return dynlibdir)+getDataDir = catchIO (getEnv "a_datadir") (\_ -> return datadir)+getLibexecDir = catchIO (getEnv "a_libexecdir") (\_ -> return libexecdir)+getSysconfDir = catchIO (getEnv "a_sysconfdir") (\_ -> return sysconfdir)+++++joinFileName :: String -> String -> FilePath+joinFileName "" fname = fname+joinFileName "." fname = fname+joinFileName dir "" = dir+joinFileName dir fname+ | isPathSeparator (List.last dir) = dir ++ fname+ | otherwise = dir ++ pathSeparator : fname++pathSeparator :: Char+pathSeparator = '/'++isPathSeparator :: Char -> Bool+isPathSeparator c = c == '/'
+ test/data/multi/dist-newstyle/build/x86_64-linux/ghc-9.4.0.20220623/b-1.0.0/build/autogen/Paths_b.hs view
@@ -0,0 +1,74 @@+{-# LANGUAGE CPP #-}+{-# LANGUAGE NoRebindableSyntax #-}+{-# OPTIONS_GHC -fno-warn-missing-import-lists #-}+{-# OPTIONS_GHC -w #-}+module Paths_b (+ version,+ getBinDir, getLibDir, getDynLibDir, getDataDir, getLibexecDir,+ getDataFileName, getSysconfDir+ ) where+++import qualified Control.Exception as Exception+import qualified Data.List as List+import Data.Version (Version(..))+import System.Environment (getEnv)+import Prelude+++#if defined(VERSION_base)++#if MIN_VERSION_base(4,0,0)+catchIO :: IO a -> (Exception.IOException -> IO a) -> IO a+#else+catchIO :: IO a -> (Exception.Exception -> IO a) -> IO a+#endif++#else+catchIO :: IO a -> (Exception.IOException -> IO a) -> IO a+#endif+catchIO = Exception.catch++version :: Version+version = Version [1,0,0] []++getDataFileName :: FilePath -> IO FilePath+getDataFileName name = do+ dir <- getDataDir+ return (dir `joinFileName` name)++getBinDir, getLibDir, getDynLibDir, getDataDir, getLibexecDir, getSysconfDir :: IO FilePath++++bindir, libdir, dynlibdir, datadir, libexecdir, sysconfdir :: FilePath+bindir = "/home/zubin/.cabal/bin"+libdir = "/home/zubin/.cabal/lib/x86_64-linux-ghc-9.4.0.20220623/b-1.0.0-inplace"+dynlibdir = "/home/zubin/.cabal/lib/x86_64-linux-ghc-9.4.0.20220623"+datadir = "/home/zubin/.cabal/share/x86_64-linux-ghc-9.4.0.20220623/b-1.0.0"+libexecdir = "/home/zubin/.cabal/libexec/x86_64-linux-ghc-9.4.0.20220623/b-1.0.0"+sysconfdir = "/home/zubin/.cabal/etc"++getBinDir = catchIO (getEnv "b_bindir") (\_ -> return bindir)+getLibDir = catchIO (getEnv "b_libdir") (\_ -> return libdir)+getDynLibDir = catchIO (getEnv "b_dynlibdir") (\_ -> return dynlibdir)+getDataDir = catchIO (getEnv "b_datadir") (\_ -> return datadir)+getLibexecDir = catchIO (getEnv "b_libexecdir") (\_ -> return libexecdir)+getSysconfDir = catchIO (getEnv "b_sysconfdir") (\_ -> return sysconfdir)+++++joinFileName :: String -> String -> FilePath+joinFileName "" fname = fname+joinFileName "." fname = fname+joinFileName dir "" = dir+joinFileName dir fname+ | isPathSeparator (List.last dir) = dir ++ fname+ | otherwise = dir ++ pathSeparator : fname++pathSeparator :: Char+pathSeparator = '/'++isPathSeparator :: Char -> Bool+isPathSeparator c = c == '/'
+ test/data/multi/dist-newstyle/build/x86_64-linux/ghc-9.4.0.20220623/c-1.0.0/build/autogen/Paths_c.hs view
@@ -0,0 +1,74 @@+{-# LANGUAGE CPP #-}+{-# LANGUAGE NoRebindableSyntax #-}+{-# OPTIONS_GHC -fno-warn-missing-import-lists #-}+{-# OPTIONS_GHC -w #-}+module Paths_c (+ version,+ getBinDir, getLibDir, getDynLibDir, getDataDir, getLibexecDir,+ getDataFileName, getSysconfDir+ ) where+++import qualified Control.Exception as Exception+import qualified Data.List as List+import Data.Version (Version(..))+import System.Environment (getEnv)+import Prelude+++#if defined(VERSION_base)++#if MIN_VERSION_base(4,0,0)+catchIO :: IO a -> (Exception.IOException -> IO a) -> IO a+#else+catchIO :: IO a -> (Exception.Exception -> IO a) -> IO a+#endif++#else+catchIO :: IO a -> (Exception.IOException -> IO a) -> IO a+#endif+catchIO = Exception.catch++version :: Version+version = Version [1,0,0] []++getDataFileName :: FilePath -> IO FilePath+getDataFileName name = do+ dir <- getDataDir+ return (dir `joinFileName` name)++getBinDir, getLibDir, getDynLibDir, getDataDir, getLibexecDir, getSysconfDir :: IO FilePath++++bindir, libdir, dynlibdir, datadir, libexecdir, sysconfdir :: FilePath+bindir = "/home/zubin/.cabal/bin"+libdir = "/home/zubin/.cabal/lib/x86_64-linux-ghc-9.4.0.20220623/c-1.0.0-inplace"+dynlibdir = "/home/zubin/.cabal/lib/x86_64-linux-ghc-9.4.0.20220623"+datadir = "/home/zubin/.cabal/share/x86_64-linux-ghc-9.4.0.20220623/c-1.0.0"+libexecdir = "/home/zubin/.cabal/libexec/x86_64-linux-ghc-9.4.0.20220623/c-1.0.0"+sysconfdir = "/home/zubin/.cabal/etc"++getBinDir = catchIO (getEnv "c_bindir") (\_ -> return bindir)+getLibDir = catchIO (getEnv "c_libdir") (\_ -> return libdir)+getDynLibDir = catchIO (getEnv "c_dynlibdir") (\_ -> return dynlibdir)+getDataDir = catchIO (getEnv "c_datadir") (\_ -> return datadir)+getLibexecDir = catchIO (getEnv "c_libexecdir") (\_ -> return libexecdir)+getSysconfDir = catchIO (getEnv "c_sysconfdir") (\_ -> return sysconfdir)+++++joinFileName :: String -> String -> FilePath+joinFileName "" fname = fname+joinFileName "." fname = fname+joinFileName dir "" = dir+joinFileName dir fname+ | isPathSeparator (List.last dir) = dir ++ fname+ | otherwise = dir ++ pathSeparator : fname++pathSeparator :: Char+pathSeparator = '/'++isPathSeparator :: Char -> Bool+isPathSeparator c = c == '/'
test/exe/Main.hs view
@@ -200,7 +200,7 @@ main :: IO () main = do- docWithPriorityRecorder <- makeDefaultStderrRecorder (Just [PriorityColumn, DataColumn]) Debug+ docWithPriorityRecorder <- makeDefaultStderrRecorder (Just [PriorityColumn, DataColumn]) let docWithFilteredPriorityRecorder@Recorder{ logger_ } = docWithPriorityRecorder@@ -596,13 +596,19 @@ expectDiagnostics [ ( "Main.hs" , [(DsError, (6, 9),- if ghcVersion >= GHC94- then "Variable not in scope: map" -- See https://gitlab.haskell.org/ghc/ghc/-/issues/22130- else "Not in scope: \8216ThisList.map\8217")+ if ghcVersion >= GHC96 then+ "Variable not in scope: ThisList.map"+ else if ghcVersion >= GHC94 then+ "Variable not in scope: map" -- See https://gitlab.haskell.org/ghc/ghc/-/issues/22130+ else+ "Not in scope: \8216ThisList.map\8217") ,(DsError, (7, 9),- if ghcVersion >= GHC94- then "Variable not in scope: x" -- See https://gitlab.haskell.org/ghc/ghc/-/issues/22130- else "Not in scope: \8216BaseList.x\8217")+ if ghcVersion >= GHC96 then+ "Variable not in scope: BaseList.x"+ else if ghcVersion >= GHC94 then+ "Variable not in scope: x" -- See https://gitlab.haskell.org/ghc/ghc/-/issues/22130+ else+ "Not in scope: \8216BaseList.x\8217") ] ) ]@@ -950,7 +956,7 @@ , ("head = 233", "head :: Integer") , ("rank2Test (k :: forall a . a -> a) = (k 233 :: Int, k \"QAQ\")", "rank2Test :: (forall a. a -> a) -> (Int, " <> listOfChar <> ")") , ("symbolKindTest = Proxy @\"qwq\"", "symbolKindTest :: Proxy \"qwq\"")- , ("promotedKindTest = Proxy @Nothing", "promotedKindTest :: Proxy 'Nothing")+ , ("promotedKindTest = Proxy @Nothing", if ghcVersion >= GHC96 then "promotedKindTest :: Proxy Nothing" else "promotedKindTest :: Proxy 'Nothing") , ("typeOperatorTest = Refl", if ghcVersion >= GHC92 then "typeOperatorTest :: forall {k} {a :: k}. a :~: a" else "typeOperatorTest :: a :~: a") , ("notInScopeTest = mkCharType", "notInScopeTest :: String -> Data.Data.DataType") ]@@ -1026,6 +1032,7 @@ ExpectRange expectedRange -> checkHoverRange expectedRange rangeInHover msg ExpectHoverRange expectedRange -> checkHoverRange expectedRange rangeInHover msg ExpectHoverText snippets -> liftIO $ traverse_ (`assertFoundIn` msg) snippets+ ExpectHoverExcludeText snippets -> liftIO $ traverse_ (`assertNotFoundIn` msg) snippets ExpectHoverTextRegex re -> liftIO $ assertBool ("Regex not found in " <> T.unpack msg) (msg =~ re :: Bool) ExpectNoHover -> liftIO $ assertFailure $ "Expected no hover but got " <> show hover _ -> pure () -- all other expectations not relevant to hover@@ -1054,6 +1061,11 @@ (T.unpack $ "failed to find: `" <> part <> "` in hover message:\n" <> whole) (part `T.isInfixOf` whole) + assertNotFoundIn :: T.Text -> T.Text -> Assertion+ assertNotFoundIn part whole = assertBool+ (T.unpack $ "found unexpected: `" <> part <> "` in hover message:\n" <> whole)+ (not . T.isInfixOf part $ whole)+ sourceFilePath = T.unpack sourceFileName sourceFileName = "GotoHover.hs" @@ -1130,6 +1142,7 @@ imported = Position 56 13 ; importedSig = getDocUri "Foo.hs" >>= \foo -> return [ExpectHoverText ["foo", "Foo", "Haddock"], mkL foo 5 0 5 3] reexported = Position 55 14 ; reexportedSig = getDocUri "Bar.hs" >>= \bar -> return [ExpectHoverText ["Bar", "Bar", "Haddock"], mkL bar 3 (if ghcVersion >= GHC94 then 5 else 0) 3 (if ghcVersion >= GHC94 then 8 else 14)] thLocL57 = Position 59 10 ; thLoc = [ExpectHoverText ["Identity"]]+ cmtL68 = Position 67 0 ; lackOfdEq = [ExpectHoverExcludeText ["$dEq"]] in mkFindTests -- def hover look expect@@ -1173,6 +1186,7 @@ , test no broken chrL36 litC "literal Char in hover info #1016" , test no broken txtL8 litT "literal Text in hover info #1016" , test no broken lstL43 litL "literal List in hover info #1016"+ , test yes yes cmtL68 lackOfdEq "no Core symbols #3280" , if ghcVersion >= GHC90 then test no yes docL41 constr "type constraint in hover info #1012" else@@ -1234,6 +1248,7 @@ -- Error: cabal: Failed to build ghc-typelits-natnormalise-0.7.7 (which is -- required by plugin-1.0.0). See the build log above for details.+ ignoreFor (BrokenForGHC [GHC96]) "fragile, frequently times out" $ ignoreFor (BrokenSpecific Windows [GHC94]) "ghc-typelist-natnormalise fails to build on GHC 9.4.2 for windows only" $ testSessionWithExtraFiles "plugin-knownnat" "simple plugin" $ \dir -> do _ <- openDoc (dir </> "KnownNat.hs") "haskell"@@ -1768,7 +1783,7 @@ [] ] where- brokenForWinGhc = knownBrokenFor (BrokenSpecific Windows [GHC810, GHC90, GHC92, GHC94]) "Windows has strange things in scope for some reason"+ brokenForWinGhc = knownBrokenFor (BrokenSpecific Windows [GHC810, GHC90, GHC92, GHC94, GHC96]) "Windows has strange things in scope for some reason" otherCompletionTests :: [TestTree] otherCompletionTests = [@@ -2000,7 +2015,7 @@ , "bar = fo" ] test doc (Position 2 8) "foo" Nothing ["*Defined at line 2, column 1 in this module*\n"]- , testSession "local single line doc without '\\n'" $ do+ , testSession "local single line doc without newline" $ do doc <- createDoc "A.hs" "haskell" $ T.unlines [ "module A where" , "-- |docdoc"@@ -2008,7 +2023,7 @@ , "bar = fo" ] test doc (Position 3 8) "foo" Nothing ["*Defined at line 3, column 1 in this module*\n* * *\n\n\ndocdoc\n"]- , testSession "local multi line doc with '\\n'" $ do+ , testSession "local multi line doc with newline" $ do doc <- createDoc "A.hs" "haskell" $ T.unlines [ "module A where" , "-- | abcabc"@@ -2017,7 +2032,7 @@ , "bar = fo" ] test doc (Position 4 8) "foo" Nothing ["*Defined at line 4, column 1 in this module*\n* * *\n\n\nabcabc\n"]- , testSession "local multi line doc without '\\n'" $ do+ , testSession "local multi line doc without newline" $ do doc <- createDoc "A.hs" "haskell" $ T.unlines [ "module A where" , "-- | abcabc"@@ -2057,10 +2072,10 @@ test doc (Position 1 7) "id" (Just $ T.length expected) [expected] ] where- brokenForGhc9 = knownBrokenFor (BrokenForGHC [GHC90, GHC92, GHC94]) "Completion doc doesn't support ghc9"+ brokenForGhc9 = knownBrokenFor (BrokenForGHC [GHC90, GHC92, GHC94, GHC96]) "Completion doc doesn't support ghc9" brokenForWinGhc9 = knownBrokenFor (BrokenSpecific Windows [GHC90, GHC92]) "Extern doc doesn't support Windows for ghc9.2" -- https://gitlab.haskell.org/ghc/ghc/-/issues/20903- brokenForMacGhc9 = knownBrokenFor (BrokenSpecific MacOS [GHC90, GHC92, GHC94]) "Extern doc doesn't support MacOS for ghc9"+ brokenForMacGhc9 = knownBrokenFor (BrokenSpecific MacOS [GHC90, GHC92, GHC94, GHC96]) "Extern doc doesn't support MacOS for ghc9" test doc pos label mn expected = do _ <- waitForDiagnostics compls <- getCompletions doc pos@@ -2108,7 +2123,7 @@ , DocumentHighlight (R 6 10 6 13) (Just HkRead) , DocumentHighlight (R 7 12 7 15) (Just HkRead) ]- , knownBrokenForGhcVersions [GHC90, GHC92, GHC94] "Ghc9 highlights the constructor and not just this field" $+ , knownBrokenForGhcVersions [GHC90, GHC92, GHC94, GHC96] "Ghc9 highlights the constructor and not just this field" $ testSessionWait "record" $ do doc <- createDoc "A.hs" "haskell" recsource _ <- waitForDiagnostics@@ -2339,7 +2354,7 @@ ignoreFor (BrokenSpecific Windows [GHC810]) "tests are unreliable in windows for ghc 8.10" ignoreForGHC92Plus :: String -> TestTree -> TestTree-ignoreForGHC92Plus = ignoreFor (BrokenForGHC [GHC92, GHC94])+ignoreForGHC92Plus = ignoreFor (BrokenForGHC [GHC92, GHC94, GHC96]) knownBrokenForGhcVersions :: [GhcVersion] -> String -> TestTree -> TestTree knownBrokenForGhcVersions ghcVers = knownBrokenFor (BrokenForGHC ghcVers)@@ -2390,6 +2405,7 @@ -- | ExpectDefRange Range -- Only gotoDef should report this range | ExpectHoverRange Range -- Only hover should report this range | ExpectHoverText [T.Text] -- the hover message must contain these snippets+ | ExpectHoverExcludeText [T.Text] -- the hover message must _not_ contain these snippets | ExpectHoverTextRegex T.Text -- the hover message must match this pattern | ExpectExternFail -- definition lookup in other file expected to fail | ExpectNoDefinitions