From 7132d1cf87b96d8919b8240bbc11a1c1bc46e9ac Mon Sep 17 00:00:00 2001 From: Nathan Maxson Date: Thu, 10 Aug 2023 16:12:08 +0300 Subject: [PATCH 01/18] WIP --- ghcide/ghcide.cabal | 2 - ghcide/src/Development/IDE/Core/Actions.hs | 2 +- ghcide/src/Development/IDE/Core/Compile.hs | 31 +++------- ghcide/src/Development/IDE/Core/FileStore.hs | 1 - .../Development/IDE/Core/IdeConfiguration.hs | 4 +- .../src/Development/IDE/Core/PluginUtils.hs | 26 +++++++- .../Development/IDE/Core/PositionMapping.hs | 4 +- .../src/Development/IDE/Core/Preprocessor.hs | 1 - .../Development/IDE/Core/ProgressReporting.hs | 2 +- ghcide/src/Development/IDE/Core/Rules.hs | 22 +++---- ghcide/src/Development/IDE/Core/Shake.hs | 16 +++-- ghcide/src/Development/IDE/Core/Tracing.hs | 4 -- ghcide/src/Development/IDE/GHC/CPP.hs | 2 - ghcide/src/Development/IDE/GHC/Compat.hs | 8 --- ghcide/src/Development/IDE/GHC/Compat/Core.hs | 19 ++---- ghcide/src/Development/IDE/GHC/Compat/Env.hs | 44 +++++++------- .../src/Development/IDE/GHC/Compat/Logger.hs | 1 - .../Development/IDE/GHC/Compat/Outputable.hs | 10 ++-- .../src/Development/IDE/GHC/Compat/Parser.hs | 9 +-- .../src/Development/IDE/GHC/Compat/Plugins.hs | 31 +++++----- .../src/Development/IDE/GHC/Compat/Units.hs | 55 ++++++++--------- ghcide/src/Development/IDE/GHC/Compat/Util.hs | 1 - ghcide/src/Development/IDE/GHC/CoreFile.hs | 4 +- ghcide/src/Development/IDE/GHC/Orphans.hs | 3 - ghcide/src/Development/IDE/GHC/Util.hs | 9 --- .../src/Development/IDE/Import/FindImports.hs | 3 +- ghcide/src/Development/IDE/LSP/Outline.hs | 1 - ghcide/src/Development/IDE/Main.hs | 23 ++++---- .../src/Development/IDE/Plugin/Completions.hs | 7 +-- .../IDE/Plugin/Completions/Logic.hs | 59 ++++++++++--------- .../IDE/Plugin/Completions/Types.hs | 4 +- ghcide/src/Development/IDE/Plugin/Test.hs | 1 - .../src/Development/IDE/Plugin/TypeLenses.hs | 2 +- .../Development/IDE/Spans/Documentation.hs | 1 - ghcide/src/Development/IDE/Spans/Pragmas.hs | 6 +- ghcide/src/Development/IDE/Types/Exports.hs | 12 ++-- ghcide/src/Development/IDE/Types/Options.hs | 3 +- 37 files changed, 183 insertions(+), 250 deletions(-) diff --git a/ghcide/ghcide.cabal b/ghcide/ghcide.cabal index 3df6359a37..e649c0333b 100644 --- a/ghcide/ghcide.cabal +++ b/ghcide/ghcide.cabal @@ -221,9 +221,7 @@ library ghc-options: -Wall - -Wno-name-shadowing -Wincomplete-uni-patterns - -Wno-unticked-promoted-constructors -fno-ignore-asserts if flag(ghc-patched-unboxed-bytecode) diff --git a/ghcide/src/Development/IDE/Core/Actions.hs b/ghcide/src/Development/IDE/Core/Actions.hs index 41b068cc0c..6b9004b0d5 100644 --- a/ghcide/src/Development/IDE/Core/Actions.hs +++ b/ghcide/src/Development/IDE/Core/Actions.hs @@ -67,7 +67,7 @@ getAtPoint file pos = runMaybeT $ do !pos' <- MaybeT (return $ fromCurrentPosition mapping pos) MaybeT $ liftIO $ fmap (first (toCurrentRange mapping =<<)) <$> AtPoint.atPoint opts hf dkMap env pos' --- | For each Loacation, determine if we have the PositionMapping +-- | For each Location, determine if we have the PositionMapping -- for the correct file. If not, get the correct position mapping -- and then apply the position mapping to the location. toCurrentLocations diff --git a/ghcide/src/Development/IDE/Core/Compile.hs b/ghcide/src/Development/IDE/Core/Compile.hs index 27932497b2..05e303aa8f 100644 --- a/ghcide/src/Development/IDE/Core/Compile.hs +++ b/ghcide/src/Development/IDE/Core/Compile.hs @@ -42,8 +42,8 @@ module Development.IDE.Core.Compile import Control.Monad.IO.Class import Control.Concurrent.Extra import Control.Concurrent.STM.Stats hiding (orElse) -import Control.DeepSeq (NFData (..), force, liftRnf, - rnf, rwhnf) +import Control.DeepSeq (NFData (..), force, + rnf) import Control.Exception (evaluate) import Control.Exception.Safe import Control.Lens hiding (List, (<.>)) @@ -62,10 +62,8 @@ import Data.Generics.Aliases import Data.Generics.Schemes import qualified Data.HashMap.Strict as HashMap import Data.IntMap (IntMap) -import qualified Data.IntMap.Strict as IntMap import Data.IORef import Data.List.Extra -import Data.Map (Map) import qualified Data.Map.Strict as Map import Data.Proxy (Proxy(Proxy)) import qualified Data.Set as Set @@ -96,7 +94,6 @@ import Development.IDE.Types.Location import Development.IDE.Types.Options import GHC (ForeignHValue, GetDocsFailure (..), - GhcException (..), parsedSource) import qualified GHC.LanguageExtensions as LangExt import GHC.Serialized @@ -108,7 +105,6 @@ import qualified Language.LSP.Protocol.Message as LSP import System.Directory import System.FilePath import System.IO.Extra (fixIO, newTempFileWithin) -import Unsafe.Coerce #if MIN_VERSION_ghc(9,0,1) import GHC.Tc.Gen.Splice @@ -127,17 +123,7 @@ import TcSplice #endif #if MIN_VERSION_ghc(9,2,0) -import GHC (Anchor (anchor), - EpaComment (EpaComment), - EpaCommentTok (EpaBlockComment, EpaLineComment), - ModuleGraph, epAnnComments, - mgLookupModule, - mgModSummaries, - priorComments) import qualified GHC as G -import GHC.Hs (LEpaComment) -import qualified GHC.Types.Error as Error -import Development.IDE.Import.DependencyInformation #endif #if MIN_VERSION_ghc(9,5,0) @@ -178,7 +164,7 @@ computePackageDeps env pkg = do newtype TypecheckHelpers = TypecheckHelpers - { getLinkables :: ([NormalizedFilePath] -> IO [LinkableResult]) -- ^ hls-graph action to get linkables for files + { getLinkables :: [NormalizedFilePath] -> IO [LinkableResult] -- ^ hls-graph action to get linkables for files } typecheckModule :: IdeDefer @@ -366,7 +352,7 @@ captureSplicesAndDeps TypecheckHelpers{..} env k = do -- We shouldn't get boot files here, but to be safe, never map them to an installed module -- because boot files don't have linkables we can load, and we will fail if we try to look -- for them - nodeKeyToInstalledModule (NodeKey_Module (ModNodeKeyWithUid (GWIB mod IsBoot) uid)) = Nothing + nodeKeyToInstalledModule (NodeKey_Module (ModNodeKeyWithUid (GWIB _ IsBoot) _)) = Nothing nodeKeyToInstalledModule (NodeKey_Module (ModNodeKeyWithUid (GWIB mod _) uid)) = Just $ mkModule uid mod nodeKeyToInstalledModule _ = Nothing moduleToNodeKey :: Module -> NodeKey @@ -508,7 +494,6 @@ mkHiFileResultCompile mkHiFileResultCompile se session' tcm simplified_guts = catchErrs $ do let session = hscSetFlags (ms_hspp_opts ms) session' ms = pm_mod_summary $ tmrParsed tcm - tcGblEnv = tmrTypechecked tcm (details, guts) <- do -- write core file @@ -594,8 +579,8 @@ mkHiFileResultCompile se session' tcm simplified_guts = catchErrs $ do (prepd_binds', _) #endif <- corePrep unprep_binds' data_tycons - let binds = noUnfoldings $ (map flattenBinds . (:[])) $ prepd_binds - binds' = noUnfoldings $ (map flattenBinds . (:[])) $ prepd_binds' + let binds = noUnfoldings $ (map flattenBinds . (:[])) prepd_binds + binds' = noUnfoldings $ (map flattenBinds . (:[])) prepd_binds' -- diffBinds is unreliable, sometimes it goes down the wrong track. -- This fixes the order of the bindings so that it is less likely to do so. @@ -1578,6 +1563,7 @@ checkLinkableDependencies hsc_env get_linkable_hashes runtime_deps = do _ -> pure $ Just $ recompBecause $ "out of date runtime dependencies: " ++ intercalate ", " (map show out_of_date) +recompBecause :: String -> RecompileRequired recompBecause = #if MIN_VERSION_ghc(9,3,0) NeedsRecompile . @@ -1689,8 +1675,7 @@ getDocsBatch hsc_env _names = do #else Map.findWithDefault mempty name amap)) #endif - return $ map (first $ T.unpack . printOutputable) - $ res + return $ map (first $ T.unpack . printOutputable) res where compiled n = -- TODO: Find a more direct indicator. diff --git a/ghcide/src/Development/IDE/Core/FileStore.hs b/ghcide/src/Development/IDE/Core/FileStore.hs index 229aaecb96..81d95c3a10 100644 --- a/ghcide/src/Development/IDE/Core/FileStore.hs +++ b/ghcide/src/Development/IDE/Core/FileStore.hs @@ -56,7 +56,6 @@ import qualified System.Directory as Dir import qualified Ide.Logger as L -import Data.Aeson (ToJSON (toJSON)) import qualified Data.Binary as B import qualified Data.ByteString.Lazy as LBS import Data.List (foldl') diff --git a/ghcide/src/Development/IDE/Core/IdeConfiguration.hs b/ghcide/src/Development/IDE/Core/IdeConfiguration.hs index c59fb2fc9d..6e0ab25983 100644 --- a/ghcide/src/Development/IDE/Core/IdeConfiguration.hs +++ b/ghcide/src/Development/IDE/Core/IdeConfiguration.hs @@ -1,4 +1,3 @@ -{-# LANGUAGE DuplicateRecordFields #-} module Development.IDE.Core.IdeConfiguration ( IdeConfiguration(..) , registerIdeConfiguration @@ -13,13 +12,12 @@ module Development.IDE.Core.IdeConfiguration where import Control.Concurrent.Strict -import Control.Lens ((^.)) import Control.Monad import Control.Monad.IO.Class import Data.Aeson.Types (Value) import Data.Hashable (Hashed, hashed, unhashed) import Data.HashSet (HashSet, singleton) -import Data.Text (Text, isPrefixOf) +import Data.Text (isPrefixOf) import Development.IDE.Core.Shake import Development.IDE.Graph import Development.IDE.Types.Location diff --git a/ghcide/src/Development/IDE/Core/PluginUtils.hs b/ghcide/src/Development/IDE/Core/PluginUtils.hs index 2b2bf2192b..76c88421c9 100644 --- a/ghcide/src/Development/IDE/Core/PluginUtils.hs +++ b/ghcide/src/Development/IDE/Core/PluginUtils.hs @@ -1,5 +1,29 @@ {-# LANGUAGE GADTs #-} -module Development.IDE.Core.PluginUtils where +module Development.IDE.Core.PluginUtils +(-- Wrapped Action functions + runActionE +, runActionMT +, useE +, useMT +, usesE +, usesMT +, useWithStaleE +, useWithStaleMT +-- Wrapped IdeAction functions +, runIdeActionE +, runIdeActionMT +, useWithStaleFastE +, useWithStaleFastMT +, uriToFilePathE +-- Wrapped PositionMapping functions +, toCurrentPositionE +, toCurrentPositionMT +, fromCurrentPositionE +, fromCurrentPositionMT +, toCurrentRangeE +, toCurrentRangeMT +, fromCurrentRangeE +, fromCurrentRangeMT) where import Control.Monad.Extra import Control.Monad.IO.Class diff --git a/ghcide/src/Development/IDE/Core/PositionMapping.hs b/ghcide/src/Development/IDE/Core/PositionMapping.hs index b80e515cc2..5dccdcf8d2 100644 --- a/ghcide/src/Development/IDE/Core/PositionMapping.hs +++ b/ghcide/src/Development/IDE/Core/PositionMapping.hs @@ -104,7 +104,7 @@ zeroMapping :: PositionMapping zeroMapping = PositionMapping idDelta -- | Compose two position mappings. Composes in the same way as function --- composition (ie the second argument is applyed to the position first). +-- composition (ie the second argument is applied to the position first). composeDelta :: PositionDelta -> PositionDelta -> PositionDelta @@ -219,7 +219,7 @@ deltaFromDiff (T.lines -> old) (T.lines -> new) = line' -> PositionExact (Position (fromIntegral line') col) -- Construct a mapping between lines in the diff - -- -1 for unsucessful mapping + -- -1 for unsuccessful mapping go :: [Diff T.Text] -> Int -> Int -> ([Int], [Int]) go [] _ _ = ([],[]) go (Both _ _ : xs) !lold !lnew = bimap (lnew :) (lold :) $ go xs (lold+1) (lnew+1) diff --git a/ghcide/src/Development/IDE/Core/Preprocessor.hs b/ghcide/src/Development/IDE/Core/Preprocessor.hs index 577e351678..7bf3638bb0 100644 --- a/ghcide/src/Development/IDE/Core/Preprocessor.hs +++ b/ghcide/src/Development/IDE/Core/Preprocessor.hs @@ -32,7 +32,6 @@ import System.FilePath import System.IO.Extra #if MIN_VERSION_ghc(9,3,0) import GHC.Utils.Logger (LogFlags (..)) -import GHC.Utils.Outputable (renderWithContext) #endif -- | Given a file and some contents, apply any necessary preprocessors, diff --git a/ghcide/src/Development/IDE/Core/ProgressReporting.hs b/ghcide/src/Development/IDE/Core/ProgressReporting.hs index 598e4d649b..be57426e3d 100644 --- a/ghcide/src/Development/IDE/Core/ProgressReporting.hs +++ b/ghcide/src/Development/IDE/Core/ProgressReporting.hs @@ -112,7 +112,7 @@ delayedProgressReporting -> Maybe (LSP.LanguageContextEnv c) -> ProgressReportingStyle -> IO ProgressReporting -delayedProgressReporting before after Nothing optProgressStyle = noProgressReporting +delayedProgressReporting _before _after Nothing _optProgressStyle = noProgressReporting delayedProgressReporting before after (Just lspEnv) optProgressStyle = do inProgressState <- newInProgress progressState <- newVar NotStarted diff --git a/ghcide/src/Development/IDE/Core/Rules.hs b/ghcide/src/Development/IDE/Core/Rules.hs index 13ad47900a..de721e5a50 100644 --- a/ghcide/src/Development/IDE/Core/Rules.hs +++ b/ghcide/src/Development/IDE/Core/Rules.hs @@ -73,9 +73,7 @@ import Control.Monad.State import Control.Monad.Trans.Except (ExceptT, except, runExceptT) import Control.Monad.Trans.Maybe -import Data.Aeson (Result (Success), - toJSON) -import qualified Data.Aeson.Types as A +import Data.Aeson (toJSON) import qualified Data.Binary as B import qualified Data.ByteString as BS import qualified Data.ByteString.Lazy as LBS @@ -146,9 +144,8 @@ import Ide.Plugin.Properties (HasProperty, Properties, ToHsType, useProperty) -import Ide.PluginUtils (configForPlugin) import Ide.Types (DynFlagsModifications (dynFlagsModifyGlobal, dynFlagsModifyParser), - PluginId, PluginDescriptor (pluginId), IdePlugins (IdePlugins)) + PluginId) import Control.Concurrent.STM.Stats (atomically) import Language.LSP.Server (LspT) import System.Info.Extra (isWindows) @@ -157,18 +154,14 @@ import Ide.Logger (Recorder, logWith, cmapWithPrio, WithPriority, Pretty (pretty import qualified Development.IDE.Core.Shake as Shake import qualified Ide.Logger as Logger import qualified Development.IDE.Types.Shake as Shake -import Development.IDE.GHC.CoreFile import Data.Time.Clock.POSIX (posixSecondsToUTCTime) import Control.Monad.IO.Unlift import qualified Data.IntMap as IM #if MIN_VERSION_ghc(9,3,0) -import GHC.Unit.Module.Graph -import GHC.Unit.Env #endif #if MIN_VERSION_ghc(9,5,0) import GHC.Unit.Home.ModInfo #endif -import GHC (mgModSummaries) import GHC.Fingerprint data Log @@ -852,7 +845,6 @@ getModIfaceFromDiskRule recorder = defineEarlyCutoff (cmapWithPrio LogShake reco Just session -> do linkableType <- getLinkableType f ver <- use_ GetModificationTime f - ShakeExtras{ideNc} <- getShakeExtras let m_old = case old of Shake.Succeeded (Just old_version) v -> Just (v, old_version) Shake.Stale _ (Just old_version) v -> Just (v, old_version) @@ -982,7 +974,7 @@ generateCoreRule recorder = getModIfaceRule :: Recorder (WithPriority Log) -> Rules () getModIfaceRule recorder = defineEarlyCutoff (cmapWithPrio LogShake recorder) $ Rule $ \GetModIface f -> do fileOfInterest <- use_ IsFileOfInterest f - res@(_,(_,mhmi)) <- case fileOfInterest of + res <- case fileOfInterest of IsFOI status -> do -- Never load from disk for files of interest tmr <- use_ TypeCheck f @@ -1128,8 +1120,6 @@ getLinkableRule recorder = Nothing -> error "called GetLinkable for a file without a linkable" Just (bin_core, hash) -> do session <- use_ GhcSessionDeps f - ShakeExtras{ideNc} <- getShakeExtras - let namecache_updater = mkUpdater ideNc linkableType <- getLinkableType f >>= \case Nothing -> error "called GetLinkable for a file which doesn't need compilation" Just t -> pure t @@ -1220,16 +1210,18 @@ uses_th_qq (ms_hspp_opts -> dflags) = -- (assuming we do in fact need to compile it). -- Depends on whether it uses unboxed tuples or sums computeLinkableTypeForDynFlags :: DynFlags -> LinkableType -computeLinkableTypeForDynFlags d #if defined(GHC_PATCHED_UNBOXED_BYTECODE) || MIN_VERSION_ghc(9,2,0) +computeLinkableTypeForDynFlags _ = BCOLinkable #else +computeLinkableTypeForDynFlags d | unboxed_tuples_or_sums = ObjectLinkable | otherwise = BCOLinkable -#endif where unboxed_tuples_or_sums = xopt LangExt.UnboxedTuples d || xopt LangExt.UnboxedSums d +#endif + -- | Tracks which linkables are current, so we don't need to unload them newtype CompiledLinkables = CompiledLinkables { getCompiledLinkables :: Var (ModuleEnv UTCTime) } diff --git a/ghcide/src/Development/IDE/Core/Shake.hs b/ghcide/src/Development/IDE/Core/Shake.hs index c70315c2fe..c077351c43 100644 --- a/ghcide/src/Development/IDE/Core/Shake.hs +++ b/ghcide/src/Development/IDE/Core/Shake.hs @@ -86,6 +86,7 @@ import Control.Concurrent.STM.Stats (atomicallyNamed) import Control.Concurrent.Strict import Control.DeepSeq import Control.Exception.Extra hiding (bracket_) +import Control.Lens ((&), (?~)) import Control.Monad.Extra import Control.Monad.IO.Class import Control.Monad.Reader @@ -99,14 +100,13 @@ import Data.Default import Data.Dynamic import Data.EnumMap.Strict (EnumMap) import qualified Data.EnumMap.Strict as EM -import Data.Foldable (find, for_, toList) +import Data.Foldable (find, for_) import Data.Functor ((<&>)) import Data.Functor.Identity import Data.Hashable import qualified Data.HashMap.Strict as HMap import Data.HashSet (HashSet) import qualified Data.HashSet as HSet -import Data.IORef import Data.List.Extra (foldl', partition, takeEnd) import qualified Data.Map.Strict as Map @@ -128,10 +128,9 @@ import Development.IDE.Core.ProgressReporting import Development.IDE.Core.RuleTypes import Development.IDE.Core.Tracing import Development.IDE.GHC.Compat (NameCache, - NameCacheUpdater (..), + NameCacheUpdater, initNameCache, - knownKeyNames, - mkSplitUniqSupply) + knownKeyNames) #if !MIN_VERSION_ghc(9,3,0) import Development.IDE.GHC.Compat (upNameCache) #endif @@ -167,6 +166,7 @@ import Ide.Types (IdePlugins (IdePlugins) PluginDescriptor (pluginId), PluginId) import Language.LSP.Diagnostics +import qualified Language.LSP.Protocol.Lens as L import Language.LSP.Protocol.Message import Language.LSP.Protocol.Types import qualified Language.LSP.Protocol.Types as LSP @@ -1281,9 +1281,8 @@ updateFileDiagnostics recorder fp ver k ShakeExtras{diagnostics, hiddenDiagnosti where diagsFromRule :: Diagnostic -> Diagnostic diagsFromRule c@Diagnostic{_range} - | coerce ideTesting = c - {_relatedInformation = - Just $ [ + | coerce ideTesting = c & L.relatedInformation ?~ + [ DiagnosticRelatedInformation (Location (filePathToUri $ fromNormalizedFilePath fp) @@ -1291,7 +1290,6 @@ updateFileDiagnostics recorder fp ver k ShakeExtras{diagnostics, hiddenDiagnosti ) (T.pack $ show k) ] - } | otherwise = c diff --git a/ghcide/src/Development/IDE/Core/Tracing.hs b/ghcide/src/Development/IDE/Core/Tracing.hs index 924adefed8..ed30a174af 100644 --- a/ghcide/src/Development/IDE/Core/Tracing.hs +++ b/ghcide/src/Development/IDE/Core/Tracing.hs @@ -1,7 +1,3 @@ -{-# LANGUAGE CPP #-} -{-# LANGUAGE PackageImports #-} -{-# LANGUAGE PatternSynonyms #-} -{-# HLINT ignore #-} module Development.IDE.Core.Tracing ( otTracedHandler diff --git a/ghcide/src/Development/IDE/GHC/CPP.hs b/ghcide/src/Development/IDE/GHC/CPP.hs index 1cb70cc174..1091d5193f 100644 --- a/ghcide/src/Development/IDE/GHC/CPP.hs +++ b/ghcide/src/Development/IDE/GHC/CPP.hs @@ -15,13 +15,11 @@ 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 #if MIN_VERSION_ghc(9,0,0) -import qualified GHC.Driver.Pipeline as Pipeline import GHC.Settings #elif MIN_VERSION_ghc (8,10,0) import qualified DriverPipeline as Pipeline diff --git a/ghcide/src/Development/IDE/GHC/Compat.hs b/ghcide/src/Development/IDE/GHC/Compat.hs index 0f9069b006..339816e80e 100644 --- a/ghcide/src/Development/IDE/GHC/Compat.hs +++ b/ghcide/src/Development/IDE/GHC/Compat.hs @@ -142,7 +142,6 @@ module Development.IDE.GHC.Compat( #endif ) where -import Data.Bifunctor import Development.IDE.GHC.Compat.Core hiding (moduleUnitId) import Development.IDE.GHC.Compat.Env import Development.IDE.GHC.Compat.Iface @@ -178,7 +177,6 @@ import qualified GHC.CoreToStg.Prep as GHC import GHC.Driver.Hooks (hscCompileCoreExprHook) #if MIN_VERSION_ghc(9,2,0) import GHC.Linker.Loader (loadExpr) -import GHC.Linker.Types (isObjectLinkable) import GHC.Runtime.Context (icInteractiveModule) import GHC.Unit.Home.ModInfo (HomePackageTable, lookupHpt) @@ -233,11 +231,9 @@ import GHC.Data.StringBuffer import GHC.Driver.Session hiding (ExposePackage) import qualified GHC.Types.SrcLoc as SrcLoc import GHC.Types.Var.Env -import GHC.Utils.Error #if MIN_VERSION_ghc(9,2,0) import GHC.Driver.Env as Env import GHC.Unit.Module.ModIface -import GHC.Unit.Module.ModSummary #else import GHC.Driver.Types #endif @@ -262,7 +258,6 @@ import Compat.HieTypes hiding (nodeAnnotations) import qualified Compat.HieTypes as GHC (nodeAnnotations) import Compat.HieUtils import qualified Data.ByteString as BS -import Data.IORef import Data.List (foldl') import qualified Data.Map as Map @@ -274,7 +269,6 @@ import GHC.ByteCode.Types import GHC.CoreToStg import GHC.Data.Maybe import GHC.Linker.Loader (loadDecls) -import GHC.Runtime.Interpreter import GHC.Stg.Pipeline import GHC.Stg.Syntax import GHC.StgToByteCode @@ -283,9 +277,7 @@ import GHC.Types.IPE #endif #if MIN_VERSION_ghc(9,3,0) -import GHC.Types.Error import GHC.Driver.Config.Stg.Pipeline -import GHC.Driver.Plugins (PsMessages (..)) #endif #if !MIN_VERSION_ghc(9,3,0) diff --git a/ghcide/src/Development/IDE/GHC/Compat/Core.hs b/ghcide/src/Development/IDE/GHC/Compat/Core.hs index 3b516c6f40..8e81ba38ec 100644 --- a/ghcide/src/Development/IDE/GHC/Compat/Core.hs +++ b/ghcide/src/Development/IDE/GHC/Compat/Core.hs @@ -3,10 +3,8 @@ {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE PatternSynonyms #-} {-# LANGUAGE ViewPatterns #-} --- TODO: remove -{-# OPTIONS -Wno-dodgy-imports -Wno-unused-imports #-} --- | Compat Core module that handles the GHC module hierarchy re-organisation +-- | Compat Core module that handles the GHC module hierarchy re-organization -- by re-exporting everything we care about. -- -- This module provides no other compat mechanisms, except for simple @@ -503,9 +501,6 @@ module Development.IDE.GHC.Compat.Core ( import qualified GHC #if MIN_VERSION_ghc(9,3,0) -import GHC.Iface.Recomp (CompileReason(..)) -import GHC.Driver.Env.Types (hsc_type_env_vars) -import GHC.Driver.Env (hscUpdateHUG, hscUpdateHPT, hsc_HUG) import GHC.Driver.Env.KnotVars import GHC.Iface.Recomp import GHC.Linker.Types @@ -566,7 +561,6 @@ import GHC.Driver.CmdLine (Warn (..)) import GHC.Driver.Hooks import GHC.Driver.Main as GHC import GHC.Driver.Monad -import GHC.Driver.Phases import GHC.Driver.Pipeline import GHC.Driver.Plugins import GHC.Driver.Session hiding (ExposePackage) @@ -581,7 +575,6 @@ import GHC.Hs.ImpExp import GHC.Hs.Pat import GHC.Hs.Type import GHC.Hs.Utils hiding (collectHsBindsBinders) -import qualified GHC.Hs.Utils as GHC #endif #if !MIN_VERSION_ghc(9,2,0) import GHC.Hs hiding (HsLet, LetStmt) @@ -590,9 +583,7 @@ import GHC.HsToCore.Docs import GHC.HsToCore.Expr import GHC.HsToCore.Monad import GHC.Iface.Load -import GHC.Iface.Make (mkFullIface, mkPartialIface) import GHC.Iface.Make as GHC -import GHC.Iface.Recomp import GHC.Iface.Syntax import GHC.Iface.Tidy as GHC import GHC.IfaceToCore @@ -600,7 +591,6 @@ import GHC.Parser import GHC.Parser.Header hiding (getImports) #if MIN_VERSION_ghc(9,2,0) import qualified GHC.Linker.Loader as Linker -import GHC.Linker.Types import GHC.Parser.Lexer hiding (initParserState, getPsMessages) import GHC.Parser.Annotation (EpAnn (..)) import GHC.Platform.Ways @@ -669,7 +659,6 @@ import GHC.Unit.Module hiding (ModLocation (..), UnitId, toUnitId) import qualified GHC.Unit.Module as Module #if MIN_VERSION_ghc(9,2,0) -import GHC.Unit.Module.Graph (mkModuleGraph) import GHC.Unit.Module.Imported import GHC.Unit.Module.ModDetails import GHC.Unit.Module.ModGuts @@ -679,7 +668,6 @@ import GHC.Unit.Module.ModSummary (ModSummary (..)) #endif import GHC.Unit.State (ModuleOrigin (..)) import GHC.Utils.Error (Severity (..), emptyMessages) -import GHC.Utils.Panic hiding (try) import qualified GHC.Utils.Panic.Plain as Plain #else import qualified Avail @@ -769,8 +757,6 @@ import SrcLoc (Located, SrcLoc (UnhelpfulLoc), #endif -import Data.List (isSuffixOf) -import System.FilePath #if MIN_VERSION_ghc(9,2,0) @@ -1132,6 +1118,7 @@ makeSimpleDetails hsc_env = hsc_env #endif +mkIfaceTc :: HscEnv -> GHC.SafeHaskellMode -> ModDetails -> ModSummary -> TcGblEnv -> IO ModIface mkIfaceTc hsc_env sf details ms tcGblEnv = GHC.mkIfaceTc hsc_env sf details #if MIN_VERSION_ghc(9,3,0) @@ -1159,6 +1146,7 @@ initTidyOpts = pure #endif +driverNoStop :: StopPhase driverNoStop = #if MIN_VERSION_ghc(9,3,0) NoStop @@ -1203,6 +1191,7 @@ groupOrigin = mg_ext #else mapLoc :: (a -> b) -> SrcLoc.GenLocated l a -> SrcLoc.GenLocated l b mapLoc = SrcLoc.mapLoc +groupOrigin :: MatchGroup p body -> Origin groupOrigin = mg_origin #endif diff --git a/ghcide/src/Development/IDE/GHC/Compat/Env.hs b/ghcide/src/Development/IDE/GHC/Compat/Env.hs index 25ea24123b..b134eab3b2 100644 --- a/ghcide/src/Development/IDE/GHC/Compat/Env.hs +++ b/ghcide/src/Development/IDE/GHC/Compat/Env.hs @@ -53,51 +53,53 @@ module Development.IDE.GHC.Compat.Env ( Development.IDE.GHC.Compat.Env.platformDefaultBackend, ) where -import GHC (setInteractiveDynFlags) +import GHC (setInteractiveDynFlags) #if MIN_VERSION_ghc(9,0,0) #if MIN_VERSION_ghc(9,2,0) -import GHC.Driver.Backend as Backend +import GHC.Driver.Backend as Backend #if MIN_VERSION_ghc(9,3,0) -import GHC.Driver.Env (HscEnv) +import GHC.Driver.Env (HscEnv) #else -import GHC.Driver.Env (HscEnv, hsc_EPS) +import GHC.Driver.Env (HscEnv, hsc_EPS) #endif -import qualified GHC.Driver.Env as Env -import qualified GHC.Driver.Session as Session -import GHC.Platform.Ways hiding (hostFullWays) -import qualified GHC.Platform.Ways as Ways +import qualified GHC.Driver.Env as Env +import qualified GHC.Driver.Session as Session +import GHC.Platform.Ways hiding (hostFullWays) +import qualified GHC.Platform.Ways as Ways import GHC.Runtime.Context -import GHC.Unit.Env (UnitEnv) -import GHC.Unit.Home as Home +import GHC.Unit.Env (UnitEnv) +import GHC.Unit.Home as Home import GHC.Utils.Logger import GHC.Utils.TmpFs #else -import qualified GHC.Driver.Session as DynFlags -import GHC.Driver.Types (HscEnv, InteractiveContext (..), hsc_EPS, - setInteractivePrintName) -import qualified GHC.Driver.Types as Env -import GHC.Driver.Ways hiding (hostFullWays) -import qualified GHC.Driver.Ways as Ways +import qualified GHC.Driver.Session as DynFlags +import GHC.Driver.Types (HscEnv, + InteractiveContext (..), + hsc_EPS, + setInteractivePrintName) +import qualified GHC.Driver.Types as Env +import GHC.Driver.Ways hiding (hostFullWays) +import qualified GHC.Driver.Ways as Ways #endif -import GHC.Driver.Hooks (Hooks) -import GHC.Driver.Session hiding (mkHomeModule) +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) +import GHC.Unit.Types (Module, UnitId) #else import DynFlags import Hooks -import HscTypes as Env +import HscTypes as Env import Module #endif #if MIN_VERSION_ghc(9,0,0) #if !MIN_VERSION_ghc(9,2,0) -import qualified Data.Set as Set +import qualified Data.Set as Set #endif #endif #if !MIN_VERSION_ghc(9,2,0) diff --git a/ghcide/src/Development/IDE/GHC/Compat/Logger.hs b/ghcide/src/Development/IDE/GHC/Compat/Logger.hs index d7bc9deadc..15c6266ec3 100644 --- a/ghcide/src/Development/IDE/GHC/Compat/Logger.hs +++ b/ghcide/src/Development/IDE/GHC/Compat/Logger.hs @@ -14,7 +14,6 @@ import Development.IDE.GHC.Compat.Env as Env import Development.IDE.GHC.Compat.Outputable #if MIN_VERSION_ghc(9,0,0) -import GHC.Driver.Session as DynFlags import GHC.Utils.Outputable #if MIN_VERSION_ghc(9,2,0) import GHC.Driver.Env (hsc_logger) diff --git a/ghcide/src/Development/IDE/GHC/Compat/Outputable.hs b/ghcide/src/Development/IDE/GHC/Compat/Outputable.hs index c4f9cd57bd..4d64c1652f 100644 --- a/ghcide/src/Development/IDE/GHC/Compat/Outputable.hs +++ b/ghcide/src/Development/IDE/GHC/Compat/Outputable.hs @@ -59,14 +59,13 @@ import GHC.Parser.Errors #else import GHC.Parser.Errors.Types #endif -import qualified GHC.Parser.Errors.Ppr as Ppr import qualified GHC.Types.Error as Error import GHC.Types.Name.Ppr import GHC.Types.Name.Reader import GHC.Types.SourceError import GHC.Types.SrcLoc import GHC.Unit.State -import GHC.Utils.Error hiding (mkWarnMsg) +import GHC.Utils.Error import GHC.Utils.Outputable as Out hiding (defaultUserStyle) import qualified GHC.Utils.Outputable as Out @@ -98,7 +97,6 @@ import GHC.Driver.Errors.Types (GhcMessage) #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) @@ -220,17 +218,21 @@ type ErrMsg = MsgEnvelope DecoratedSDoc type WarnMsg = MsgEnvelope DecoratedSDoc #endif +#if MIN_VERSION_ghc(9,5,0) mkPrintUnqualifiedDefault :: HscEnv -> GlobalRdrEnv -> PrintUnqualified mkPrintUnqualifiedDefault env = -#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) +mkPrintUnqualifiedDefault :: HscEnv -> GlobalRdrEnv -> PrintUnqualified +mkPrintUnqualifiedDefault env = -- GHC 9.2 version -- mkPrintUnqualified :: UnitEnv -> GlobalRdrEnv -> PrintUnqualified mkPrintUnqualified (hsc_unit_env env) #else +mkPrintUnqualifiedDefault :: HscEnv -> GlobalRdrEnv -> PrintUnqualified +mkPrintUnqualifiedDefault env = HscTypes.mkPrintUnqualified (hsc_dflags env) #endif diff --git a/ghcide/src/Development/IDE/GHC/Compat/Parser.hs b/ghcide/src/Development/IDE/GHC/Compat/Parser.hs index 2fd5b74efd..0f5a61e864 100644 --- a/ghcide/src/Development/IDE/GHC/Compat/Parser.hs +++ b/ghcide/src/Development/IDE/GHC/Compat/Parser.hs @@ -53,11 +53,7 @@ import qualified GHC.Parser.Annotation as Anno import qualified GHC.Parser.Lexer as Lexer import GHC.Types.SrcLoc (PsSpan (..)) #if MIN_VERSION_ghc(9,2,0) -import GHC (Anchor (anchor), - EpAnnComments (priorComments), - EpaComment (EpaComment), - EpaCommentTok (..), - epAnnComments, +import GHC (EpaCommentTok (..), pm_extra_src_files, pm_mod_summary, pm_parsed_source) @@ -67,8 +63,7 @@ import qualified GHC.Driver.Config.Parser as Config #else import qualified GHC.Driver.Config as Config #endif -import GHC.Hs (LEpaComment, hpm_module, - hpm_src_files) +import GHC.Hs (hpm_module, hpm_src_files) import GHC.Parser.Lexer hiding (initParserState) #endif #else diff --git a/ghcide/src/Development/IDE/GHC/Compat/Plugins.hs b/ghcide/src/Development/IDE/GHC/Compat/Plugins.hs index 79e1602e02..90170b9117 100644 --- a/ghcide/src/Development/IDE/GHC/Compat/Plugins.hs +++ b/ghcide/src/Development/IDE/GHC/Compat/Plugins.hs @@ -21,31 +21,28 @@ module Development.IDE.GHC.Compat.Plugins ( #if MIN_VERSION_ghc(9,0,0) #if MIN_VERSION_ghc(9,2,0) -import qualified GHC.Driver.Env as Env +import qualified GHC.Driver.Env as Env #endif -import GHC.Driver.Plugins (Plugin (..), - PluginWithArgs (..), - StaticPlugin (..), - defaultPlugin, - withPlugins) +import GHC.Driver.Plugins (Plugin (..), + PluginWithArgs (..), + StaticPlugin (..), + defaultPlugin, withPlugins) #if MIN_VERSION_ghc(9,3,0) -import GHC.Driver.Plugins (ParsedResult (..), - PsMessages (..), - staticPlugins) -import qualified GHC.Parser.Lexer as Lexer +import GHC.Driver.Plugins (ParsedResult (..), + PsMessages (..), + staticPlugins) +import qualified GHC.Parser.Lexer as Lexer #else -import Data.Bifunctor (bimap) +import Data.Bifunctor (bimap) #endif -import qualified GHC.Runtime.Loader as Loader +import qualified GHC.Runtime.Loader as Loader #else -import qualified DynamicLoading as Loader +import qualified DynamicLoading as Loader import Plugins #endif import Development.IDE.GHC.Compat.Core -import Development.IDE.GHC.Compat.Env (hscSetFlags, hsc_dflags) -import Development.IDE.GHC.Compat.Outputable as Out -import Development.IDE.GHC.Compat.Parser as Parser -import Development.IDE.GHC.Compat.Util (Bag) +import Development.IDE.GHC.Compat.Env (hscSetFlags, hsc_dflags) +import Development.IDE.GHC.Compat.Parser as Parser #if !MIN_VERSION_ghc(9,3,0) diff --git a/ghcide/src/Development/IDE/GHC/Compat/Units.hs b/ghcide/src/Development/IDE/GHC/Compat/Units.hs index 5b1b5e0c58..7b4811e870 100644 --- a/ghcide/src/Development/IDE/GHC/Compat/Units.hs +++ b/ghcide/src/Development/IDE/GHC/Compat/Units.hs @@ -54,72 +54,67 @@ module Development.IDE.GHC.Compat.Units ( ) where import Control.Monad -import qualified Data.List.NonEmpty as NE -import qualified Data.Map.Strict as Map +import qualified Data.List.NonEmpty as NE +import qualified Data.Map.Strict as Map #if MIN_VERSION_ghc(9,3,0) import GHC.Unit.Home.ModInfo #endif #if MIN_VERSION_ghc(9,0,0) #if MIN_VERSION_ghc(9,2,0) -import qualified GHC.Data.ShortText as ST +import qualified GHC.Data.ShortText as ST #if !MIN_VERSION_ghc(9,3,0) -import GHC.Driver.Env (hsc_unit_dbs) +import GHC.Driver.Env (hsc_unit_dbs) #endif import GHC.Driver.Ppr import GHC.Unit.Env import GHC.Unit.External -import GHC.Unit.Finder hiding - (findImportedModule) +import GHC.Unit.Finder hiding (findImportedModule) #else import GHC.Driver.Types #endif -import GHC.Data.FastString -import qualified GHC.Driver.Session as DynFlags +import qualified GHC.Driver.Session as DynFlags import GHC.Types.Unique.Set -import qualified GHC.Unit.Info as UnitInfo -import GHC.Unit.State (LookupResult, UnitInfo, - UnitState (unitInfoMap)) -import qualified GHC.Unit.State as State -import GHC.Unit.Types hiding (moduleUnit, - toUnitId) -import qualified GHC.Unit.Types as Unit +import qualified GHC.Unit.Info as UnitInfo +import GHC.Unit.State (LookupResult, UnitInfo, + UnitState (unitInfoMap)) +import qualified GHC.Unit.State as State +import GHC.Unit.Types hiding (moduleUnit, toUnitId) +import qualified GHC.Unit.Types as Unit import GHC.Utils.Outputable #else import qualified DynFlags import FastString -import GhcPlugins (SDoc, showSDocForUser) +import GhcPlugins (SDoc, showSDocForUser) import HscTypes -import Module hiding (moduleUnitId) +import Module hiding (moduleUnitId) import qualified Module -import Packages (InstalledPackageInfo (haddockInterfaces, packageName), - LookupResult, - PackageConfig, - PackageConfigMap, - PackageState, - getPackageConfigMap, - lookupPackage') +import Packages (InstalledPackageInfo (haddockInterfaces, packageName), + LookupResult, PackageConfig, + PackageConfigMap, + PackageState, + getPackageConfigMap, + lookupPackage') import qualified Packages #endif 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) +import Data.Map (Map) #endif import Data.Either import Data.Version import qualified GHC #if MIN_VERSION_ghc(9,3,0) -import GHC.Types.PkgQual (PkgQual (NoPkgQual)) +import GHC.Types.PkgQual (PkgQual (NoPkgQual)) #endif #if MIN_VERSION_ghc(9,1,0) -import qualified GHC.Unit.Finder as GHC +import qualified GHC.Unit.Finder as GHC #elif MIN_VERSION_ghc(9,0,0) -import qualified GHC.Driver.Finder as GHC +import qualified GHC.Driver.Finder as GHC #else -import qualified Finder as GHC +import qualified Finder as GHC #endif #if MIN_VERSION_ghc(9,0,0) diff --git a/ghcide/src/Development/IDE/GHC/Compat/Util.hs b/ghcide/src/Development/IDE/GHC/Compat/Util.hs index b0ef8e1217..22b278f36e 100644 --- a/ghcide/src/Development/IDE/GHC/Compat/Util.hs +++ b/ghcide/src/Development/IDE/GHC/Compat/Util.hs @@ -82,7 +82,6 @@ import GHC.Data.StringBuffer import GHC.Types.Unique import GHC.Types.Unique.DFM import GHC.Utils.Fingerprint -import GHC.Utils.Misc import GHC.Utils.Outputable (pprHsString) import GHC.Utils.Panic hiding (try) #else diff --git a/ghcide/src/Development/IDE/GHC/CoreFile.hs b/ghcide/src/Development/IDE/GHC/CoreFile.hs index ed11a26300..715951f2bf 100644 --- a/ghcide/src/Development/IDE/GHC/CoreFile.hs +++ b/ghcide/src/Development/IDE/GHC/CoreFile.hs @@ -19,7 +19,7 @@ import Data.Foldable import Data.IORef import Data.List (isPrefixOf) import Data.Maybe -import qualified Data.Text as T +import qualified Data.Text as T import GHC.Fingerprint import Development.IDE.GHC.Compat @@ -118,7 +118,7 @@ writeBinCoreFile core_path fat_iface = do #if MIN_VERSION_ghc(9,2,0) QuietBinIFace #else - (const $ pure ()) + const $ pure () #endif putWithUserData quietTrace bh fat_iface diff --git a/ghcide/src/Development/IDE/GHC/Orphans.hs b/ghcide/src/Development/IDE/GHC/Orphans.hs index 581ae70567..b34fa77d1e 100644 --- a/ghcide/src/Development/IDE/GHC/Orphans.hs +++ b/ghcide/src/Development/IDE/GHC/Orphans.hs @@ -18,9 +18,7 @@ import GHC.Data.FastString import qualified GHC.Data.StringBuffer as SB import GHC.Types.Name.Occurrence import GHC.Types.SrcLoc -import GHC.Types.Unique (getKey) import GHC.Unit.Info -import GHC.Utils.Outputable #else import Bag import GhcPlugins @@ -40,7 +38,6 @@ import Data.String (IsString (fromString)) import Data.Text (unpack) #if MIN_VERSION_ghc(9,0,0) import GHC.ByteCode.Types -import GHC (ModuleGraph) #else import ByteCodeTypes #endif diff --git a/ghcide/src/Development/IDE/GHC/Util.hs b/ghcide/src/Development/IDE/GHC/Util.hs index ca108ebc4d..29ff450d64 100644 --- a/ghcide/src/Development/IDE/GHC/Util.hs +++ b/ghcide/src/Development/IDE/GHC/Util.hs @@ -56,18 +56,13 @@ import qualified Data.ByteString as BS import Data.ByteString.Internal (ByteString (..)) import qualified Data.ByteString.Internal as BS import qualified Data.ByteString.Lazy as LBS -import Data.Data (Data) import Data.IORef import Data.List.Extra import Data.Maybe import qualified Data.Text as T import qualified Data.Text.Encoding as T import qualified Data.Text.Encoding.Error as T -import Data.Time.Clock.POSIX (POSIXTime, getCurrentTime, - utcTimeToPOSIXSeconds) import Data.Typeable -import qualified Data.Unique as U -import Debug.Trace import Development.IDE.GHC.Compat as GHC import qualified Development.IDE.GHC.Compat.Parser as Compat import qualified Development.IDE.GHC.Compat.Units as Compat @@ -82,12 +77,8 @@ import GHC.IO.Encoding import GHC.IO.Exception import GHC.IO.Handle.Internals import GHC.IO.Handle.Types -import GHC.Stack import Ide.PluginUtils (unescape) -import System.Environment.Blank (getEnvDefault) import System.FilePath -import System.IO.Unsafe -import Text.Printf ---------------------------------------------------------------------- diff --git a/ghcide/src/Development/IDE/Import/FindImports.hs b/ghcide/src/Development/IDE/Import/FindImports.hs index a8e63bf4a1..5f7f1c4cd1 100644 --- a/ghcide/src/Development/IDE/Import/FindImports.hs +++ b/ghcide/src/Development/IDE/Import/FindImports.hs @@ -15,7 +15,6 @@ module Development.IDE.Import.FindImports import Control.DeepSeq import Development.IDE.GHC.Compat as Compat -import Development.IDE.GHC.Compat.Util import Development.IDE.GHC.Error as ErrUtils import Development.IDE.GHC.Orphans () import Development.IDE.Types.Diagnostics @@ -89,7 +88,7 @@ locateModuleFile import_dirss exts targetFor isSource modName = do -- as they can never be imported into another package. #if MIN_VERSION_ghc(9,3,0) mkImportDirs :: HscEnv -> (UnitId, DynFlags) -> Maybe (UnitId, [FilePath]) -mkImportDirs env (i, flags) = Just (i, importPaths flags) +mkImportDirs _env (i, flags) = Just (i, importPaths flags) #else mkImportDirs :: HscEnv -> (UnitId, DynFlags) -> Maybe (PackageName, (UnitId, [FilePath])) mkImportDirs env (i, flags) = (, (i, importPaths flags)) <$> getUnitName env i diff --git a/ghcide/src/Development/IDE/LSP/Outline.hs b/ghcide/src/Development/IDE/LSP/Outline.hs index 77e622dfe2..4b0a9f4754 100644 --- a/ghcide/src/Development/IDE/LSP/Outline.hs +++ b/ghcide/src/Development/IDE/LSP/Outline.hs @@ -14,7 +14,6 @@ import Data.Functor import Data.Foldable (toList) import Data.Generics hiding (Prefix) import Data.Maybe -import qualified Data.Text as T import Development.IDE.Core.Rules import Development.IDE.Core.Shake import Development.IDE.GHC.Compat diff --git a/ghcide/src/Development/IDE/Main.hs b/ghcide/src/Development/IDE/Main.hs index b440b4c2ff..09e0c8cca3 100644 --- a/ghcide/src/Development/IDE/Main.hs +++ b/ghcide/src/Development/IDE/Main.hs @@ -1,6 +1,5 @@ -{-# LANGUAGE PackageImports #-} {-# OPTIONS_GHC -Wno-orphans #-} -{-# LANGUAGE RankNTypes #-} +{-# LANGUAGE RankNTypes #-} module Development.IDE.Main (Arguments(..) ,defaultArguments @@ -30,10 +29,8 @@ import Data.List.Extra (intercalate, import Data.Maybe (catMaybes, isJust) import qualified Data.Text as T import Development.IDE (Action, - GhcVersion (..), Priority (Debug, Error), - Rules, ghcVersion, - hDuplicateTo') + Rules, hDuplicateTo') import Development.IDE.Core.Debouncer (Debouncer, newAsyncDebouncer) import Development.IDE.Core.FileStore (isWatchSupported) @@ -77,14 +74,6 @@ import Development.IDE.Session (SessionLoadingOptions import qualified Development.IDE.Session as Session import Development.IDE.Types.Location (NormalizedUri, toNormalizedFilePath') -import Ide.Logger (Logger, - Pretty (pretty), - Priority (Info, Warning), - Recorder, - WithPriority, - cmapWithPrio, - logWith, nest, vsep, - (<+>)) import Development.IDE.Types.Monitoring (Monitoring) import Development.IDE.Types.Options (IdeGhcSession, IdeOptions (optCheckParents, optCheckProject, optReportProgress, optRunSubset), @@ -99,6 +88,14 @@ import GHC.IO.Encoding (setLocaleEncoding) import GHC.IO.Handle (hDuplicate) import HIE.Bios.Cradle (findCradle) import qualified HieDb.Run as HieDb +import Ide.Logger (Logger, + Pretty (pretty), + Priority (Info), + Recorder, + WithPriority, + cmapWithPrio, + logWith, nest, vsep, + (<+>)) import Ide.Plugin.Config (CheckParents (NeverCheck), Config, checkParents, checkProject, diff --git a/ghcide/src/Development/IDE/Plugin/Completions.hs b/ghcide/src/Development/IDE/Plugin/Completions.hs index 97c58131b1..79c8a9cade 100644 --- a/ghcide/src/Development/IDE/Plugin/Completions.hs +++ b/ghcide/src/Development/IDE/Plugin/Completions.hs @@ -11,11 +11,10 @@ module Development.IDE.Plugin.Completions import Control.Concurrent.Async (concurrently) import Control.Concurrent.STM.Stats (readTVarIO) -import Control.Lens ((&), (.~)) +import Control.Lens ((&), (.~), (?~)) import Control.Monad.IO.Class import Control.Monad.Trans.Except (ExceptT (ExceptT), withExceptT) -import Data.Aeson import qualified Data.HashMap.Strict as Map import qualified Data.HashSet as Set import Data.Maybe @@ -155,7 +154,7 @@ resolveCompletion ide _pid comp@CompletionItem{_detail,_documentation,_data_} ur InR $ MarkupContent MarkupKind_Markdown $ T.intercalate sectionSeparator (old:doc) _ -> InR $ MarkupContent MarkupKind_Markdown $ T.intercalate sectionSeparator doc pure (comp & L.detail .~ (det1 <> _detail) - & L.documentation .~ Just doc1) + & L.documentation ?~ doc1) where stripForall ty = case splitForAllTyCoVars ty of (_,res) -> res @@ -207,7 +206,7 @@ getCompletionsLSP ide plId Just (cci', parsedMod, bindMap) -> do let pfix = getCompletionPrefix position cnts case (pfix, completionContext) of - ((PosPrefixInfo _ "" _ _), Just CompletionContext { _triggerCharacter = Just "."}) + (PosPrefixInfo _ "" _ _, Just CompletionContext { _triggerCharacter = Just "."}) -> return (InL []) (_, _) -> do let clientCaps = clientCapabilities $ shakeExtras ide diff --git a/ghcide/src/Development/IDE/Plugin/Completions/Logic.hs b/ghcide/src/Development/IDE/Plugin/Completions/Logic.hs index d370b5142a..eac9ac5e35 100644 --- a/ghcide/src/Development/IDE/Plugin/Completions/Logic.hs +++ b/ghcide/src/Development/IDE/Plugin/Completions/Logic.hs @@ -1,8 +1,8 @@ -{-# LANGUAGE CPP #-} +{-# LANGUAGE CPP #-} {-# LANGUAGE DuplicateRecordFields #-} -{-# LANGUAGE GADTs #-} -{-# LANGUAGE MultiWayIf #-} -{-# LANGUAGE OverloadedLabels #-} +{-# LANGUAGE GADTs #-} +{-# LANGUAGE MultiWayIf #-} +{-# LANGUAGE OverloadedLabels #-} -- Mostly taken from "haskell-ide-engine" module Development.IDE.Plugin.Completions.Logic ( @@ -24,8 +24,8 @@ import Data.List.Extra as List hiding import qualified Data.Map as Map import Data.Row -import Data.Maybe (catMaybes, fromMaybe, - isJust, isNothing, +import Data.Maybe (fromMaybe, isJust, + isNothing, listToMaybe, mapMaybe) import qualified Data.Text as T @@ -34,14 +34,11 @@ import qualified Text.Fuzzy.Parallel as Fuzzy import Control.Monad import Data.Aeson (ToJSON (toJSON)) import Data.Function (on) -import Data.Functor -import qualified Data.HashMap.Strict as HM import qualified Data.HashSet as HashSet import Data.Monoid (First (..)) import Data.Ord (Down (Down)) import qualified Data.Set as Set -import Development.IDE.Core.Compile import Development.IDE.Core.PositionMapping import Development.IDE.GHC.Compat hiding (ppr) import qualified Development.IDE.GHC.Compat as GHC @@ -50,19 +47,14 @@ import Development.IDE.GHC.CoreFile (occNamePrefixes) import Development.IDE.GHC.Error import Development.IDE.GHC.Util import Development.IDE.Plugin.Completions.Types -import Development.IDE.Spans.Common -import Development.IDE.Spans.Documentation import Development.IDE.Spans.LocalBindings import Development.IDE.Types.Exports -import Development.IDE.Types.HscEnvEq import Development.IDE.Types.Options #if MIN_VERSION_ghc(9,2,0) import GHC.Plugins (Depth (AllTheWay), - defaultSDocContext, mkUserStyle, neverQualify, - renderWithContext, sdocStyle) #endif import Ide.PluginUtils (mkLspCommand) @@ -144,12 +136,15 @@ getCContext pos pm | pos `isInsideSrcSpan` r = Just TypeContext goInline _ = Nothing +#if MIN_VERSION_ghc(9,5,0) 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 + importGo :: GHC.LImportDecl GhcPs -> Maybe Context + importGo (L (locA -> r) impDecl) + | pos `isInsideSrcSpan` r = importInline importModuleName (fmap (fmap reLoc) $ ideclHiding impDecl) #endif <|> Just (ImportContext importModuleName) @@ -160,18 +155,24 @@ getCContext pos pm -- importInline :: String -> Maybe (Bool, GHC.Located [LIE GhcPs]) -> Maybe Context #if MIN_VERSION_ghc(9,5,0) importInline modName (Just (EverythingBut, L r _)) + | pos `isInsideSrcSpan` r = Just $ ImportHidingContext modName + | otherwise = Nothing #else importInline modName (Just (True, L r _)) -#endif | pos `isInsideSrcSpan` r = Just $ ImportHidingContext modName | otherwise = Nothing +#endif + #if MIN_VERSION_ghc(9,5,0) importInline modName (Just (Exactly, L r _)) + | pos `isInsideSrcSpan` r = Just $ ImportListContext modName + | otherwise = Nothing #else importInline modName (Just (False, L r _)) -#endif | pos `isInsideSrcSpan` r = Just $ ImportListContext modName | otherwise = Nothing +#endif + importInline _ _ = Nothing occNameToComKind :: OccName -> CompletionItemKind @@ -191,7 +192,7 @@ mkCompl :: Maybe PluginId -- ^ Plugin to use for the extend import command -> IdeOptions -> Uri -> CompItem -> CompletionItem mkCompl pId - IdeOptions {..} + _ideOptions uri CI { compKind, @@ -285,27 +286,27 @@ showForSnippet x = printOutputable x mkModCompl :: T.Text -> CompletionItem mkModCompl label = - (defaultCompletionItemWithLabel label) - { _kind = Just CompletionItemKind_Module } + defaultCompletionItemWithLabel label + & L.kind ?~ CompletionItemKind_Module mkModuleFunctionImport :: T.Text -> T.Text -> CompletionItem mkModuleFunctionImport moduleName label = - (defaultCompletionItemWithLabel label) - { _kind = Just CompletionItemKind_Function - , _detail = Just moduleName } + defaultCompletionItemWithLabel label + & L.kind ?~ CompletionItemKind_Function + & L.detail ?~ moduleName mkImportCompl :: T.Text -> T.Text -> CompletionItem mkImportCompl enteredQual label = - (defaultCompletionItemWithLabel m) - { _kind = Just CompletionItemKind_Module - , _detail = Just label } + defaultCompletionItemWithLabel m + & L.kind ?~ CompletionItemKind_Module + & L.detail ?~ label where m = fromMaybe "" (T.stripPrefix enteredQual label) mkExtCompl :: T.Text -> CompletionItem mkExtCompl label = - (defaultCompletionItemWithLabel label) - { _kind = Just CompletionItemKind_Keyword } + defaultCompletionItemWithLabel label + & L.kind ?~ CompletionItemKind_Keyword defaultCompletionItemWithLabel :: T.Text -> CompletionItem defaultCompletionItemWithLabel label = @@ -396,7 +397,7 @@ cacheDataProducer uri visibleMods curMod globalEnv inScopeEnv limports = in (unqual,QualCompls qual) toCompItem :: Parent -> Module -> T.Text -> Name -> Maybe (LImportDecl GhcPs) -> [CompItem] - toCompItem par m mn n imp' = + toCompItem par _ mn n imp' = -- docs <- getDocumentationTryGhc packageState curMod n let (mbParent, originName) = case par of NoParent -> (Nothing, nameOccName n) diff --git a/ghcide/src/Development/IDE/Plugin/Completions/Types.hs b/ghcide/src/Development/IDE/Plugin/Completions/Types.hs index 9151e03955..048a3f1b4d 100644 --- a/ghcide/src/Development/IDE/Plugin/Completions/Types.hs +++ b/ghcide/src/Development/IDE/Plugin/Completions/Types.hs @@ -19,7 +19,7 @@ import Data.Text (Text) import Data.Typeable (Typeable) import Development.IDE.GHC.Compat import Development.IDE.Graph (RuleResult) -import Development.IDE.Spans.Common +import Development.IDE.Spans.Common () import GHC.Generics (Generic) import Ide.Plugin.Properties import Language.LSP.Protocol.Types (CompletionItemKind (..), Uri) @@ -200,7 +200,7 @@ instance ToJSON NameDetails where instance Show NameDetails where show = show . toJSON --- | The data that is acutally sent for resolve support +-- | The data that is actually sent for resolve support -- We need the URI to be able to reconstruct the GHC environment -- in the file the completion was triggered in. data CompletionResolveData = CompletionResolveData diff --git a/ghcide/src/Development/IDE/Plugin/Test.hs b/ghcide/src/Development/IDE/Plugin/Test.hs index a90cd875fb..72a1d5b912 100644 --- a/ghcide/src/Development/IDE/Plugin/Test.hs +++ b/ghcide/src/Development/IDE/Plugin/Test.hs @@ -46,7 +46,6 @@ import Development.IDE.Types.Action import Development.IDE.Types.HscEnvEq (HscEnvEq (hscEnv)) import Development.IDE.Types.Location (fromUri) import GHC.Generics (Generic) -import Ide.Plugin.Config (CheckParents) import Ide.Plugin.Error import Ide.Types import Language.LSP.Protocol.Message diff --git a/ghcide/src/Development/IDE/Plugin/TypeLenses.hs b/ghcide/src/Development/IDE/Plugin/TypeLenses.hs index 84ee6f0c67..5ce2529fe8 100644 --- a/ghcide/src/Development/IDE/Plugin/TypeLenses.hs +++ b/ghcide/src/Development/IDE/Plugin/TypeLenses.hs @@ -19,7 +19,7 @@ import Control.Monad (mzero) import Control.Monad.Extra (whenMaybe) import Control.Monad.IO.Class (MonadIO (liftIO)) import Control.Monad.Trans.Class (MonadTrans (lift)) -import Data.Aeson.Types (Value, toJSON) +import Data.Aeson.Types (toJSON) import qualified Data.Aeson.Types as A import Data.List (find) import qualified Data.Map as Map diff --git a/ghcide/src/Development/IDE/Spans/Documentation.hs b/ghcide/src/Development/IDE/Spans/Documentation.hs index 0c7200c89b..390c56f82d 100644 --- a/ghcide/src/Development/IDE/Spans/Documentation.hs +++ b/ghcide/src/Development/IDE/Spans/Documentation.hs @@ -34,7 +34,6 @@ import System.FilePath import Language.LSP.Protocol.Types (filePathToUri, getUri) #if MIN_VERSION_ghc(9,3,0) -import GHC.Types.Unique.Map #endif mkDocMap diff --git a/ghcide/src/Development/IDE/Spans/Pragmas.hs b/ghcide/src/Development/IDE/Spans/Pragmas.hs index d41e68bc5d..16ec9858db 100644 --- a/ghcide/src/Development/IDE/Spans/Pragmas.hs +++ b/ghcide/src/Development/IDE/Spans/Pragmas.hs @@ -9,8 +9,8 @@ module Development.IDE.Spans.Pragmas , insertNewPragma , getFirstPragma ) where +import Control.Lens ((&), (.~)) import Data.Bits (Bits (setBit)) -import Data.Function ((&)) import qualified Data.List as List import qualified Data.Maybe as Maybe import Data.Text (Text, pack) @@ -25,7 +25,7 @@ import Ide.Plugin.Error (PluginError) import Ide.Types (PluginId(..)) import qualified Data.Text as T import Development.IDE.Core.PluginUtils - +import qualified Language.LSP.Protocol.Lens as L getNextPragmaInfo :: DynFlags -> Maybe Text -> NextPragmaInfo getNextPragmaInfo dynFlags sourceText = if | Just sourceText <- sourceText @@ -46,7 +46,7 @@ showExtension NamedFieldPuns = "NamedFieldPuns" showExtension ext = pack (show ext) insertNewPragma :: NextPragmaInfo -> Extension -> LSP.TextEdit -insertNewPragma (NextPragmaInfo _ (Just (LineSplitTextEdits ins _))) newPragma = ins { LSP._newText = "{-# LANGUAGE " <> showExtension newPragma <> " #-}\n" } :: LSP.TextEdit +insertNewPragma (NextPragmaInfo _ (Just (LineSplitTextEdits ins _))) newPragma = ins & L.newText .~ "{-# LANGUAGE " <> showExtension newPragma <> " #-}\n" :: LSP.TextEdit insertNewPragma (NextPragmaInfo nextPragmaLine _) newPragma = LSP.TextEdit pragmaInsertRange $ "{-# LANGUAGE " <> showExtension newPragma <> " #-}\n" where pragmaInsertPosition = LSP.Position (fromIntegral nextPragmaLine) 0 diff --git a/ghcide/src/Development/IDE/Types/Exports.hs b/ghcide/src/Development/IDE/Types/Exports.hs index d8491c72e1..3a507eb3c0 100644 --- a/ghcide/src/Development/IDE/Types/Exports.hs +++ b/ghcide/src/Development/IDE/Types/Exports.hs @@ -23,19 +23,15 @@ module Development.IDE.Types.Exports import Control.DeepSeq (NFData (..), force, ($!!)) import Control.Monad -import Data.Bifunctor (Bifunctor (second)) import Data.Char (isUpper) import Data.Hashable (Hashable) -import Data.HashMap.Strict (HashMap, elems) -import qualified Data.HashMap.Strict as Map import Data.HashSet (HashSet) import qualified Data.HashSet as Set -import Data.List (foldl', isSuffixOf) +import Data.List (isSuffixOf) import Data.Text (Text, uncons) import Data.Text.Encoding (decodeUtf8, encodeUtf8) import Development.IDE.GHC.Compat import Development.IDE.GHC.Orphans () -import Development.IDE.GHC.Util import GHC.Generics (Generic) import HieDb @@ -63,13 +59,13 @@ instance Show ExportsMap where updateExportsMap :: ExportsMap -> ExportsMap -> ExportsMap updateExportsMap old new = ExportsMap { getExportsMap = delListFromOccEnv (getExportsMap old) old_occs `plusOccEnv` getExportsMap new -- plusOccEnv is right biased - , getModuleExportsMap = (getModuleExportsMap old) `plusUFM` (getModuleExportsMap new) -- plusUFM is right biased + , getModuleExportsMap = getModuleExportsMap old `plusUFM` getModuleExportsMap new -- plusUFM is right biased } where old_occs = concat [map name $ Set.toList (lookupWithDefaultUFM_Directly (getModuleExportsMap old) mempty m_uniq) | m_uniq <- nonDetKeysUFM (getModuleExportsMap new)] size :: ExportsMap -> Int -size = sum . map (Set.size) . nonDetOccEnvElts . getExportsMap +size = sum . map Set.size . nonDetOccEnvElts . getExportsMap mkVarOrDataOcc :: Text -> OccName mkVarOrDataOcc t = mkOcc $ mkFastStringByteString $ encodeUtf8 t @@ -162,7 +158,7 @@ createExportsMap modIface = do where doOne modIFace = do let getModDetails = unpackAvail $ moduleName $ mi_module modIFace - concatMap (getModDetails) (mi_exports modIFace) + concatMap getModDetails (mi_exports modIFace) createExportsMapMg :: [ModGuts] -> ExportsMap createExportsMapMg modGuts = do diff --git a/ghcide/src/Development/IDE/Types/Options.hs b/ghcide/src/Development/IDE/Types/Options.hs index 17bf035439..9d4b18ad52 100644 --- a/ghcide/src/Development/IDE/Types/Options.hs +++ b/ghcide/src/Development/IDE/Types/Options.hs @@ -2,8 +2,7 @@ -- SPDX-License-Identifier: Apache-2.0 -- | Options -{-# LANGUAGE OverloadedLabels #-} -{-# LANGUAGE RankNTypes #-} +{-# LANGUAGE RankNTypes #-} module Development.IDE.Types.Options ( IdeOptions(..) , IdePreprocessedSource(..) From 1c408ee4c74c0c75d9bda5671dd388a063658c19 Mon Sep 17 00:00:00 2001 From: Nathan Maxson Date: Fri, 11 Aug 2023 19:31:46 +0300 Subject: [PATCH 02/18] cleanup cpp, mark 8.10 redundant imports --- ghcide/src/Development/IDE/Core/Compile.hs | 43 ++- ghcide/src/Development/IDE/Core/FileStore.hs | 2 + ghcide/src/Development/IDE/Core/FileUtils.hs | 1 + .../Development/IDE/Core/IdeConfiguration.hs | 5 +- .../src/Development/IDE/Core/Preprocessor.hs | 2 + ghcide/src/Development/IDE/Core/Rules.hs | 23 +- ghcide/src/Development/IDE/Core/Shake.hs | 17 +- ghcide/src/Development/IDE/GHC/CPP.hs | 15 +- ghcide/src/Development/IDE/GHC/Compat.hs | 139 +++---- ghcide/src/Development/IDE/GHC/Compat/Core.hs | 364 +++++++++--------- ghcide/src/Development/IDE/GHC/Compat/Env.hs | 72 ++-- .../src/Development/IDE/GHC/Compat/Iface.hs | 29 +- .../src/Development/IDE/GHC/Compat/Logger.hs | 13 +- .../Development/IDE/GHC/Compat/Outputable.hs | 57 +-- .../src/Development/IDE/GHC/Compat/Parser.hs | 54 ++- .../src/Development/IDE/GHC/Compat/Plugins.hs | 49 ++- .../src/Development/IDE/GHC/Compat/Units.hs | 107 ++--- ghcide/src/Development/IDE/GHC/Compat/Util.hs | 33 +- ghcide/src/Development/IDE/GHC/CoreFile.hs | 35 +- ghcide/src/Development/IDE/GHC/Orphans.hs | 46 ++- ghcide/src/Development/IDE/GHC/Util.hs | 56 ++- .../src/Development/IDE/Import/FindImports.hs | 2 + ghcide/src/Development/IDE/LSP/Outline.hs | 3 + ghcide/src/Development/IDE/Main.hs | 22 +- ghcide/src/Development/IDE/Monitoring/EKG.hs | 1 + .../src/Development/IDE/Plugin/Completions.hs | 3 + .../IDE/Plugin/Completions/Logic.hs | 33 +- .../IDE/Plugin/Completions/Types.hs | 12 +- ghcide/src/Development/IDE/Plugin/Test.hs | 2 + .../src/Development/IDE/Plugin/TypeLenses.hs | 3 +- .../Development/IDE/Spans/Documentation.hs | 3 +- ghcide/src/Development/IDE/Spans/Pragmas.hs | 17 +- ghcide/src/Development/IDE/Types/Exports.hs | 11 +- 33 files changed, 721 insertions(+), 553 deletions(-) diff --git a/ghcide/src/Development/IDE/Core/Compile.hs b/ghcide/src/Development/IDE/Core/Compile.hs index 05e303aa8f..8e71948617 100644 --- a/ghcide/src/Development/IDE/Core/Compile.hs +++ b/ghcide/src/Development/IDE/Core/Compile.hs @@ -42,8 +42,9 @@ module Development.IDE.Core.Compile import Control.Monad.IO.Class import Control.Concurrent.Extra import Control.Concurrent.STM.Stats hiding (orElse) -import Control.DeepSeq (NFData (..), force, - rnf) +import Control.DeepSeq (NFData (..), force, liftRnf, + rnf, rwhnf) +-- 8.10 The import of ‘liftRnf, rwhnf’from module ‘Control.DeepSeq’ is redundant import Control.Exception (evaluate) import Control.Exception.Safe import Control.Lens hiding (List, (<.>)) @@ -62,11 +63,14 @@ import Data.Generics.Aliases import Data.Generics.Schemes import qualified Data.HashMap.Strict as HashMap import Data.IntMap (IntMap) +import qualified Data.IntMap.Strict as IntMap import Data.IORef import Data.List.Extra +import Data.Map (Map) import qualified Data.Map.Strict as Map import Data.Proxy (Proxy(Proxy)) import qualified Data.Set as Set +-- 8.10 The qualified import of ‘Data.Set’ is redundant except perhaps to import instances from ‘Data.Set’ import Data.Maybe import qualified Data.Text as T import Data.Time (UTCTime (..)) @@ -94,6 +98,7 @@ import Development.IDE.Types.Location import Development.IDE.Types.Options import GHC (ForeignHValue, GetDocsFailure (..), + GhcException (..), parsedSource) import qualified GHC.LanguageExtensions as LangExt import GHC.Serialized @@ -105,25 +110,39 @@ import qualified Language.LSP.Protocol.Message as LSP import System.Directory import System.FilePath import System.IO.Extra (fixIO, newTempFileWithin) +import Unsafe.Coerce + +#if !MIN_VERSION_ghc(9,0,1) +import HscTypes +import TcSplice +#endif #if MIN_VERSION_ghc(9,0,1) import GHC.Tc.Gen.Splice - -#if MIN_VERSION_ghc(9,2,1) -import GHC.Types.ForeignStubs -import GHC.Types.HpcInfo -import GHC.Types.TypeEnv -#else -import GHC.Driver.Types #endif -#else -import HscTypes -import TcSplice +#if MIN_VERSION_ghc(9,0,1) && !MIN_VERSION_ghc(9,2,1) +import GHC.Driver.Types #endif #if MIN_VERSION_ghc(9,2,0) +import GHC (Anchor (anchor), + EpaComment (EpaComment), + EpaCommentTok (EpaBlockComment, EpaLineComment), + ModuleGraph, epAnnComments, + mgLookupModule, + mgModSummaries, + priorComments) import qualified GHC as G +import GHC.Hs (LEpaComment) +import qualified GHC.Types.Error as Error +import Development.IDE.Import.DependencyInformation +#endif + +#if MIN_VERSION_ghc(9,2,1) +import GHC.Types.ForeignStubs +import GHC.Types.HpcInfo +import GHC.Types.TypeEnv #endif #if MIN_VERSION_ghc(9,5,0) diff --git a/ghcide/src/Development/IDE/Core/FileStore.hs b/ghcide/src/Development/IDE/Core/FileStore.hs index 81d95c3a10..1f0b9df24c 100644 --- a/ghcide/src/Development/IDE/Core/FileStore.hs +++ b/ghcide/src/Development/IDE/Core/FileStore.hs @@ -56,6 +56,8 @@ import qualified System.Directory as Dir import qualified Ide.Logger as L +import Data.Aeson (ToJSON (toJSON)) +-- 8.0 The import of ‘Data.Aeson’ is redundant except perhaps to import instances from ‘Data.Aeson’ import qualified Data.Binary as B import qualified Data.ByteString.Lazy as LBS import Data.List (foldl') diff --git a/ghcide/src/Development/IDE/Core/FileUtils.hs b/ghcide/src/Development/IDE/Core/FileUtils.hs index 4725ed83bd..e8ff7299b4 100644 --- a/ghcide/src/Development/IDE/Core/FileUtils.hs +++ b/ghcide/src/Development/IDE/Core/FileUtils.hs @@ -6,6 +6,7 @@ module Development.IDE.Core.FileUtils( import Data.Time.Clock.POSIX + #ifdef mingw32_HOST_OS import qualified System.Directory as Dir #else diff --git a/ghcide/src/Development/IDE/Core/IdeConfiguration.hs b/ghcide/src/Development/IDE/Core/IdeConfiguration.hs index 6e0ab25983..7d389fd1da 100644 --- a/ghcide/src/Development/IDE/Core/IdeConfiguration.hs +++ b/ghcide/src/Development/IDE/Core/IdeConfiguration.hs @@ -12,12 +12,15 @@ module Development.IDE.Core.IdeConfiguration where import Control.Concurrent.Strict +import Control.Lens ((^.)) +-- 8.10 The import of ‘Control.Lens’ is redundant except perhaps to import instances from ‘Control.Lens’ import Control.Monad import Control.Monad.IO.Class import Data.Aeson.Types (Value) import Data.Hashable (Hashed, hashed, unhashed) import Data.HashSet (HashSet, singleton) -import Data.Text (isPrefixOf) +import Data.Text (Text, isPrefixOf) +-- 8.10 The import of ‘Text’ from module ‘Data.Text’ is redundant import Development.IDE.Core.Shake import Development.IDE.Graph import Development.IDE.Types.Location diff --git a/ghcide/src/Development/IDE/Core/Preprocessor.hs b/ghcide/src/Development/IDE/Core/Preprocessor.hs index 7bf3638bb0..b138e16afd 100644 --- a/ghcide/src/Development/IDE/Core/Preprocessor.hs +++ b/ghcide/src/Development/IDE/Core/Preprocessor.hs @@ -30,8 +30,10 @@ import Development.IDE.Types.Location import qualified GHC.LanguageExtensions as LangExt import System.FilePath import System.IO.Extra + #if MIN_VERSION_ghc(9,3,0) import GHC.Utils.Logger (LogFlags (..)) +import GHC.Utils.Outputable (renderWithContext) #endif -- | Given a file and some contents, apply any necessary preprocessors, diff --git a/ghcide/src/Development/IDE/Core/Rules.hs b/ghcide/src/Development/IDE/Core/Rules.hs index de721e5a50..6ed2a9842c 100644 --- a/ghcide/src/Development/IDE/Core/Rules.hs +++ b/ghcide/src/Development/IDE/Core/Rules.hs @@ -73,7 +73,11 @@ import Control.Monad.State import Control.Monad.Trans.Except (ExceptT, except, runExceptT) import Control.Monad.Trans.Maybe -import Data.Aeson (toJSON) +import Data.Aeson (Result (Success), + toJSON) +-- 8.10 The import of ‘Result, Success’from module ‘Data.Aeson’ is redundant +import qualified Data.Aeson.Types as A +-- 8.10 The qualified import of ‘Data.Aeson.Types’ is redundant except perhaps to import instances from ‘Data.Aeson.Types’ import qualified Data.Binary as B import qualified Data.ByteString as BS import qualified Data.ByteString.Lazy as LBS @@ -144,8 +148,11 @@ import Ide.Plugin.Properties (HasProperty, Properties, ToHsType, useProperty) +import Ide.PluginUtils (configForPlugin) +-- 8.10 The import of ‘Ide.PluginUtils’ is redundant except perhaps to import instances from ‘Ide.PluginUtils’ import Ide.Types (DynFlagsModifications (dynFlagsModifyGlobal, dynFlagsModifyParser), - PluginId) + PluginId, PluginDescriptor (pluginId), IdePlugins (IdePlugins)) +-- 8.10 The import of ‘IdePlugins, IdePlugins, PluginDescriptor, PluginDescriptor(pluginId)’from module ‘Ide.Types’ is redundant import Control.Concurrent.STM.Stats (atomically) import Language.LSP.Server (LspT) import System.Info.Extra (isWindows) @@ -154,15 +161,25 @@ import Ide.Logger (Recorder, logWith, cmapWithPrio, WithPriority, Pretty (pretty import qualified Development.IDE.Core.Shake as Shake import qualified Ide.Logger as Logger import qualified Development.IDE.Types.Shake as Shake +import Development.IDE.GHC.CoreFile +-- The import of ‘Development.IDE.GHC.CoreFile’ is redundant except perhaps to import instances from ‘Development.IDE.GHC.CoreFile’ import Data.Time.Clock.POSIX (posixSecondsToUTCTime) import Control.Monad.IO.Unlift import qualified Data.IntMap as IM +-- The qualified import of ‘Data.IntMap’ is redundant except perhaps to import instances from ‘Data.IntMap’ +import GHC (mgModSummaries) +import GHC.Fingerprint + #if MIN_VERSION_ghc(9,3,0) +import GHC.Unit.Module.Graph +import GHC.Unit.Env #endif + #if MIN_VERSION_ghc(9,5,0) import GHC.Unit.Home.ModInfo #endif -import GHC.Fingerprint + + data Log = LogShake Shake.Log diff --git a/ghcide/src/Development/IDE/Core/Shake.hs b/ghcide/src/Development/IDE/Core/Shake.hs index c077351c43..87e5883497 100644 --- a/ghcide/src/Development/IDE/Core/Shake.hs +++ b/ghcide/src/Development/IDE/Core/Shake.hs @@ -100,13 +100,15 @@ import Data.Default import Data.Dynamic import Data.EnumMap.Strict (EnumMap) import qualified Data.EnumMap.Strict as EM -import Data.Foldable (find, for_) +import Data.Foldable (find, for_, toList) +-- 8.10 The import of ‘toList’ from module ‘Data.Foldable’ is redundant import Data.Functor ((<&>)) import Data.Functor.Identity import Data.Hashable import qualified Data.HashMap.Strict as HMap import Data.HashSet (HashSet) import qualified Data.HashSet as HSet +import Data.IORef import Data.List.Extra (foldl', partition, takeEnd) import qualified Data.Map.Strict as Map @@ -128,12 +130,11 @@ import Development.IDE.Core.ProgressReporting import Development.IDE.Core.RuleTypes import Development.IDE.Core.Tracing import Development.IDE.GHC.Compat (NameCache, - NameCacheUpdater, + NameCacheUpdater (..), initNameCache, - knownKeyNames) -#if !MIN_VERSION_ghc(9,3,0) -import Development.IDE.GHC.Compat (upNameCache) -#endif + knownKeyNames, + mkSplitUniqSupply) + import qualified Data.Aeson.Types as A import Development.IDE.GHC.Orphans () import Development.IDE.Graph hiding (ShakeValue) @@ -179,6 +180,10 @@ import System.FilePath hiding (makeRelative) import System.IO.Unsafe (unsafePerformIO) import System.Time.Extra +#if !MIN_VERSION_ghc(9,3,0) +import Development.IDE.GHC.Compat (upNameCache) +#endif + data Log = LogCreateHieDbExportsMapStart | LogCreateHieDbExportsMapFinish !Int diff --git a/ghcide/src/Development/IDE/GHC/CPP.hs b/ghcide/src/Development/IDE/GHC/CPP.hs index 1091d5193f..8359621750 100644 --- a/ghcide/src/Development/IDE/GHC/CPP.hs +++ b/ghcide/src/Development/IDE/GHC/CPP.hs @@ -15,25 +15,30 @@ module Development.IDE.GHC.CPP(doCpp, addOptP) where +import Control.Monad +-- 8.10 The import of ‘Control.Monad’ is redundant except perhaps to import instances from ‘Control.Monad’ import Development.IDE.GHC.Compat as Compat import Development.IDE.GHC.Compat.Util import GHC -#if MIN_VERSION_ghc(9,0,0) -import GHC.Settings -#elif MIN_VERSION_ghc (8,10,0) +#if MIN_VERSION_ghc (8,10,0) && !MIN_VERSION_ghc(9,0,0) import qualified DriverPipeline as Pipeline import ToolSettings #endif -#if MIN_VERSION_ghc(9,5,0) -import qualified GHC.SysTools.Cpp as Pipeline +#if MIN_VERSION_ghc(9,0,0) +import qualified GHC.Driver.Pipeline as Pipeline +import GHC.Settings #endif #if MIN_VERSION_ghc(9,3,0) import qualified GHC.Driver.Pipeline.Execute as Pipeline #endif +#if MIN_VERSION_ghc(9,5,0) +import qualified GHC.SysTools.Cpp as Pipeline +#endif + addOptP :: String -> DynFlags -> DynFlags addOptP f = alterToolSettings $ \s -> s { toolSettings_opt_P = f : toolSettings_opt_P s diff --git a/ghcide/src/Development/IDE/GHC/Compat.hs b/ghcide/src/Development/IDE/GHC/Compat.hs index 339816e80e..91c38513ee 100644 --- a/ghcide/src/Development/IDE/GHC/Compat.hs +++ b/ghcide/src/Development/IDE/GHC/Compat.hs @@ -142,6 +142,7 @@ module Development.IDE.GHC.Compat( #endif ) where +import Data.Bifunctor import Development.IDE.GHC.Compat.Core hiding (moduleUnitId) import Development.IDE.GHC.Compat.Env import Development.IDE.GHC.Compat.Iface @@ -155,52 +156,20 @@ import GHC hiding (HasSrcSpan, ModLocation, RealSrcSpan, exprType, getLoc, lookupName) - import Data.Coerce (coerce) import Data.String (IsString (fromString)) +import Compat.HieAst (enrichHie) +import Compat.HieBin +import Compat.HieTypes hiding (nodeAnnotations) +import qualified Compat.HieTypes as GHC (nodeAnnotations) +import Compat.HieUtils +import qualified Data.ByteString as BS +import Data.IORef +import Data.List (foldl') +import qualified Data.Map as Map +import qualified Data.Set as S - -#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) -import qualified GHC.CoreToStg.Prep as GHC -import GHC.Driver.Hooks (hscCompileCoreExprHook) -#if MIN_VERSION_ghc(9,2,0) -import GHC.Linker.Loader (loadExpr) -import GHC.Runtime.Context (icInteractiveModule) -import GHC.Unit.Home.ModInfo (HomePackageTable, - lookupHpt) -#if MIN_VERSION_ghc(9,3,0) -import GHC.Unit.Module.Deps (Dependencies(dep_direct_mods), Usage(..)) -#else -import GHC.Unit.Module.Deps (Dependencies(dep_mods), Usage(..)) -#endif -#else -import GHC.CoreToByteCode (coreExprToBCOs) -import GHC.Driver.Types (Dependencies (dep_mods), - HomePackageTable, - icInteractiveModule, - lookupHpt) -import GHC.Runtime.Linker (linkExpr) -#endif -import GHC.ByteCode.Asm (bcoFreeNames) -import GHC.Types.Annotations (AnnTarget (ModuleTarget), - Annotation (..), - extendAnnEnvList) -import GHC.Types.Unique.DFM as UniqDFM -import GHC.Types.Unique.DSet as UniqDSet -import GHC.Types.Unique.Set as UniqSet -#else +#if !MIN_VERSION_ghc(9,0,0) import Annotations (AnnTarget (ModuleTarget), Annotation (..), extendAnnEnvList) @@ -222,64 +191,100 @@ import UniqDSet import UniqSet import VarEnv (emptyInScopeSet, emptyTidyEnv, mkRnEnv2) +import FastString +import qualified Avail +import DynFlags hiding (ExposePackage) +import HscTypes +import MkIface hiding (writeIfaceFile) + +import StringBuffer (hPutStringBuffer) +import qualified SysTools #endif #if MIN_VERSION_ghc(9,0,0) +import qualified GHC.Core.Opt.Pipeline as GHC +import GHC.Core.Tidy (tidyExpr) +import GHC.CoreToStg.Prep (corePrepPgm) +import qualified GHC.CoreToStg.Prep as GHC +import GHC.Driver.Hooks (hscCompileCoreExprHook) + +import GHC.ByteCode.Asm (bcoFreeNames) +import GHC.Types.Annotations (AnnTarget (ModuleTarget), + Annotation (..), + extendAnnEnvList) +import GHC.Types.Unique.DFM as UniqDFM +import GHC.Types.Unique.DSet as UniqDSet +import GHC.Types.Unique.Set as UniqSet import GHC.Data.FastString import GHC.Core import GHC.Data.StringBuffer import GHC.Driver.Session hiding (ExposePackage) import qualified GHC.Types.SrcLoc as SrcLoc import GHC.Types.Var.Env -#if MIN_VERSION_ghc(9,2,0) -import GHC.Driver.Env as Env -import GHC.Unit.Module.ModIface -#else -import GHC.Driver.Types -#endif +import GHC.Utils.Error import GHC.Iface.Env import GHC.Iface.Make (mkIfaceExports) import qualified GHC.SysTools.Tasks as SysTools import qualified GHC.Types.Avail as Avail -#else -import FastString -import qualified Avail -import DynFlags hiding (ExposePackage) -import HscTypes -import MkIface hiding (writeIfaceFile) - -import StringBuffer (hPutStringBuffer) -import qualified SysTools #endif -import Compat.HieAst (enrichHie) -import Compat.HieBin -import Compat.HieTypes hiding (nodeAnnotations) -import qualified Compat.HieTypes as GHC (nodeAnnotations) -import Compat.HieUtils -import qualified Data.ByteString as BS +#if MIN_VERSION_ghc(9,0,0) && !MIN_VERSION_ghc(9,2,0) +import GHC.CoreToByteCode (coreExprToBCOs) +import GHC.Driver.Types (Dependencies (dep_mods), + HomePackageTable, + icInteractiveModule, + lookupHpt) +import GHC.Runtime.Linker (linkExpr) -import Data.List (foldl') -import qualified Data.Map as Map -import qualified Data.Set as S +import GHC.Driver.Types +#endif + +#if MIN_VERSION_ghc(9,0,0) && !MIN_VERSION_ghc(9,5,0) +import GHC.Core.Lint (lintInteractiveExpr) +#endif #if MIN_VERSION_ghc(9,2,0) +import GHC.Linker.Loader (loadExpr) +import GHC.Linker.Types (isObjectLinkable) +import GHC.Runtime.Context (icInteractiveModule) +import GHC.Unit.Home.ModInfo (HomePackageTable, + lookupHpt) +import GHC.Driver.Env as Env +import GHC.Unit.Module.ModIface +import GHC.Unit.Module.ModSummary import GHC.Builtin.Uniques import GHC.ByteCode.Types import GHC.CoreToStg import GHC.Data.Maybe import GHC.Linker.Loader (loadDecls) +import GHC.Runtime.Interpreter import GHC.Stg.Pipeline import GHC.Stg.Syntax import GHC.StgToByteCode import GHC.Types.CostCentre import GHC.Types.IPE +#endif + +#if MIN_VERSION_ghc(9,2,0) && !MIN_VERSION_ghc(9,3,0) +import GHC.Unit.Module.Deps (Dependencies(dep_mods), Usage(..)) #endif #if MIN_VERSION_ghc(9,3,0) +import GHC.Unit.Module.Deps (Dependencies(dep_direct_mods), Usage(..)) +import GHC.Types.Error import GHC.Driver.Config.Stg.Pipeline +import GHC.Driver.Plugins (PsMessages (..)) #endif +#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) +#endif + + #if !MIN_VERSION_ghc(9,3,0) nonDetOccEnvElts :: OccEnv a -> [a] nonDetOccEnvElts = occEnvElts diff --git a/ghcide/src/Development/IDE/GHC/Compat/Core.hs b/ghcide/src/Development/IDE/GHC/Compat/Core.hs index 8e81ba38ec..b883ae78ca 100644 --- a/ghcide/src/Development/IDE/GHC/Compat/Core.hs +++ b/ghcide/src/Development/IDE/GHC/Compat/Core.hs @@ -500,176 +500,20 @@ module Development.IDE.GHC.Compat.Core ( import qualified GHC -#if MIN_VERSION_ghc(9,3,0) -import GHC.Driver.Env.KnotVars -import GHC.Iface.Recomp -import GHC.Linker.Types -import GHC.Unit.Module.Graph -import GHC.Driver.Errors.Types -import GHC.Types.Unique.Map -import GHC.Types.Unique -import GHC.Utils.TmpFs -import GHC.Utils.Panic -import GHC.Unit.Finder.Types -import GHC.Unit.Env -import GHC.Driver.Phases -#endif - -#if MIN_VERSION_ghc(9,0,0) -import GHC.Builtin.Names hiding (Unique, printName) -import GHC.Builtin.Types -import GHC.Builtin.Types.Prim -import GHC.Builtin.Utils -import GHC.Core.Class -import GHC.Core.Coercion -import GHC.Core.ConLike -import GHC.Core.DataCon hiding (dataConExTyCoVars) -import qualified GHC.Core.DataCon as DataCon -import GHC.Core.FamInstEnv hiding (pprFamInst) -import GHC.Core.InstEnv -import GHC.Types.Unique.FM hiding (UniqFM) -import qualified GHC.Types.Unique.FM as UniqFM -#if MIN_VERSION_ghc(9,3,0) -import qualified GHC.Driver.Config.Tidy as GHC -import qualified GHC.Data.Strict as Strict -#endif -#if MIN_VERSION_ghc(9,2,0) -import GHC.Data.Bag -import GHC.Core.Multiplicity (scaledThing) -#else -import GHC.Core.Ppr.TyThing hiding (pprFamInst) -import GHC.Core.TyCo.Rep (scaledThing) -#endif -import GHC.Core.PatSyn -import GHC.Core.Predicate -import GHC.Core.TyCo.Ppr -import qualified GHC.Core.TyCo.Rep as TyCoRep -import GHC.Core.TyCon -import GHC.Core.Type hiding (mkInfForAllTys) -import GHC.Core.Unify -import GHC.Core.Utils +import Data.List (isSuffixOf) +-- 8.10 The import of ‘Data.List’ is redundant except perhaps to import instances from ‘Data.List’ +import System.FilePath +-- 8.10 The import of ‘System.FilePath’ is redundant except perhaps to import instances from ‘System.FilePath’ +import Data.Foldable (toList) +-- 8.10 The import of ‘Data.Foldable’ is redundant except perhaps to import instances from ‘Data.Foldable’ +-- NOTE(ozkutuk): Cpp clashes Phase.Cpp, so we hide it. +-- Not the greatest solution, but gets the job done +-- (until the CPP extension is actually needed). +import GHC.LanguageExtensions.Type hiding (Cpp) +import GHC.Hs.Binds -#if MIN_VERSION_ghc(9,2,0) -import GHC.Driver.Env -#else -import GHC.Driver.Finder hiding (mkHomeModLocation) -import GHC.Driver.Types -import GHC.Driver.Ways -#endif -import GHC.Driver.CmdLine (Warn (..)) -import GHC.Driver.Hooks -import GHC.Driver.Main as GHC -import GHC.Driver.Monad -import GHC.Driver.Pipeline -import GHC.Driver.Plugins -import GHC.Driver.Session hiding (ExposePackage) -import qualified GHC.Driver.Session as DynFlags -#if MIN_VERSION_ghc(9,2,0) -import GHC.Hs (HsModule (..), SrcSpanAnn') -import GHC.Hs.Decls hiding (FunDep) -import GHC.Hs.Doc -import GHC.Hs.Expr -import GHC.Hs.Extension -import GHC.Hs.ImpExp -import GHC.Hs.Pat -import GHC.Hs.Type -import GHC.Hs.Utils hiding (collectHsBindsBinders) -#endif -#if !MIN_VERSION_ghc(9,2,0) -import GHC.Hs hiding (HsLet, LetStmt) -#endif -import GHC.HsToCore.Docs -import GHC.HsToCore.Expr -import GHC.HsToCore.Monad -import GHC.Iface.Load -import GHC.Iface.Make as GHC -import GHC.Iface.Syntax -import GHC.Iface.Tidy as GHC -import GHC.IfaceToCore -import GHC.Parser -import GHC.Parser.Header hiding (getImports) -#if MIN_VERSION_ghc(9,2,0) -import qualified GHC.Linker.Loader as Linker -import GHC.Parser.Lexer hiding (initParserState, getPsMessages) -import GHC.Parser.Annotation (EpAnn (..)) -import GHC.Platform.Ways -import GHC.Runtime.Context (InteractiveImport (..)) -#else -import GHC.Parser.Lexer -import qualified GHC.Runtime.Linker as Linker -#endif -import GHC.Rename.Fixity (lookupFixityRn) -import GHC.Rename.Names -import GHC.Rename.Splice -import qualified GHC.Runtime.Interpreter as GHCi -import GHC.Tc.Instance.Family -import GHC.Tc.Module -import GHC.Tc.Types -import GHC.Tc.Types.Evidence hiding ((<.>)) -import GHC.Tc.Utils.Env -import GHC.Tc.Utils.Monad hiding (Applicative (..), IORef, - MonadFix (..), MonadIO (..), - allM, anyM, concatMapM, - mapMaybeM, (<$>)) -import GHC.Tc.Utils.TcType as TcType -import qualified GHC.Types.Avail as Avail -#if MIN_VERSION_ghc(9,2,0) -import GHC.Types.Avail (greNamePrintableName) -import GHC.Types.Fixity (LexicalFixity (..), Fixity (..), defaultFixity) -#endif -#if MIN_VERSION_ghc(9,2,0) -import GHC.Types.Meta -#endif -import GHC.Types.Basic -import GHC.Types.Id -import GHC.Types.Name hiding (varName) -import GHC.Types.Name.Cache -import GHC.Types.Name.Env -import GHC.Types.Name.Reader hiding (GRE, gre_name, gre_imp, gre_lcl, gre_par) -import qualified GHC.Types.Name.Reader as RdrName -#if MIN_VERSION_ghc(9,2,0) -import GHC.Types.Name.Set -import GHC.Types.SourceFile (HscSource (..), -#if !MIN_VERSION_ghc(9,3,0) - SourceModified(..) -#endif - ) -import GHC.Types.SourceText -import GHC.Types.Target (Target (..), TargetId (..)) -import GHC.Types.TyThing -import GHC.Types.TyThing.Ppr -#else -import GHC.Types.Name.Set -#endif -import GHC.Types.SrcLoc (BufPos, BufSpan, - SrcLoc (UnhelpfulLoc), - SrcSpan (UnhelpfulSpan)) -import qualified GHC.Types.SrcLoc as SrcLoc -import GHC.Types.Unique.Supply -import GHC.Types.Var (Var (varName), setTyVarUnique, - setVarUnique) -#if MIN_VERSION_ghc(9,2,0) -import GHC.Unit.Finder hiding (mkHomeModLocation) -import GHC.Unit.Home.ModInfo -#endif -import GHC.Unit.Info (PackageName (..)) -import GHC.Unit.Module hiding (ModLocation (..), UnitId, - addBootSuffixLocnOut, moduleUnit, - toUnitId) -import qualified GHC.Unit.Module as Module -#if MIN_VERSION_ghc(9,2,0) -import GHC.Unit.Module.Imported -import GHC.Unit.Module.ModDetails -import GHC.Unit.Module.ModGuts -import GHC.Unit.Module.ModIface (IfaceExport, ModIface (..), - ModIface_ (..), mi_fix) -import GHC.Unit.Module.ModSummary (ModSummary (..)) -#endif -import GHC.Unit.State (ModuleOrigin (..)) -import GHC.Utils.Error (Severity (..), emptyMessages) -import qualified GHC.Utils.Panic.Plain as Plain -#else +#if !MIN_VERSION_ghc(9,0,0) import qualified Avail import BasicTypes hiding (Version) import Class @@ -699,7 +543,7 @@ import HscTypes import Id import IfaceSyn import InstEnv -import Lexer hiding (getSrcLoc) +import Lexer import qualified Linker import LoadIface import MkIface as GHC @@ -736,7 +580,6 @@ import TcRnMonad hiding (Applicative (..), IORef, mapMaybeM, (<$>)) import TcRnTypes import TcType -import qualified TcType import TidyPgm as GHC import qualified TyCoRep import TyCon @@ -754,38 +597,174 @@ import Coercion (coercionKind) import Predicate import SrcLoc (Located, SrcLoc (UnhelpfulLoc), SrcSpan (UnhelpfulSpan)) +import qualified Finder as GHC #endif +#if MIN_VERSION_ghc(9,0,0) +import GHC.Builtin.Names hiding (Unique, printName) +import GHC.Builtin.Types +import GHC.Builtin.Types.Prim +import GHC.Builtin.Utils +import GHC.Core.Class +import GHC.Core.Coercion +import GHC.Core.ConLike +import GHC.Core.DataCon hiding (dataConExTyCoVars) +import qualified GHC.Core.DataCon as DataCon +import GHC.Core.FamInstEnv hiding (pprFamInst) +import GHC.Core.InstEnv +import GHC.Types.Unique.FM hiding (UniqFM) +import qualified GHC.Types.Unique.FM as UniqFM +import GHC.Core.PatSyn +import GHC.Core.Predicate +import GHC.Core.TyCo.Ppr +import qualified GHC.Core.TyCo.Rep as TyCoRep +import GHC.Core.TyCon +import GHC.Core.Type hiding (mkInfForAllTys) +import GHC.Core.Unify +import GHC.Core.Utils +import GHC.Driver.CmdLine (Warn (..)) +import GHC.Driver.Hooks +import GHC.Driver.Main as GHC +import GHC.Driver.Monad +import GHC.Driver.Phases +import GHC.Driver.Pipeline +import GHC.Driver.Plugins +import GHC.Driver.Session hiding (ExposePackage) +import qualified GHC.Driver.Session as DynFlags +import GHC.HsToCore.Docs +import GHC.HsToCore.Expr +import GHC.HsToCore.Monad +import GHC.Iface.Load +import GHC.Iface.Make (mkFullIface, mkPartialIface) +import GHC.Iface.Make as GHC +import GHC.Iface.Recomp +import GHC.Iface.Syntax +import GHC.Iface.Tidy as GHC +import GHC.IfaceToCore +import GHC.Parser +import GHC.Parser.Header hiding (getImports) +import GHC.Rename.Fixity (lookupFixityRn) +import GHC.Rename.Names +import GHC.Rename.Splice +import qualified GHC.Runtime.Interpreter as GHCi +import GHC.Tc.Instance.Family +import GHC.Tc.Module +import GHC.Tc.Types +import GHC.Tc.Types.Evidence hiding ((<.>)) +import GHC.Tc.Utils.Env +import GHC.Tc.Utils.Monad hiding (Applicative (..), IORef, + MonadFix (..), MonadIO (..), + allM, anyM, concatMapM, + mapMaybeM, (<$>)) +import GHC.Tc.Utils.TcType as TcType +import qualified GHC.Types.Avail as Avail +import GHC.Types.Basic +import GHC.Types.Id +import GHC.Types.Name hiding (varName) +import GHC.Types.Name.Cache +import GHC.Types.Name.Env +import GHC.Types.Name.Reader hiding (GRE, gre_name, gre_imp, gre_lcl, gre_par) +import qualified GHC.Types.Name.Reader as RdrName +import GHC.Types.SrcLoc (BufPos, BufSpan, + SrcLoc (UnhelpfulLoc), + SrcSpan (UnhelpfulSpan)) +import qualified GHC.Types.SrcLoc as SrcLoc +import GHC.Types.Unique.Supply +import GHC.Types.Var (Var (varName), setTyVarUnique, + setVarUnique) +import GHC.Unit.Info (PackageName (..)) +import GHC.Unit.Module hiding (ModLocation (..), UnitId, + addBootSuffixLocnOut, moduleUnit, + toUnitId) +import qualified GHC.Unit.Module as Module +import GHC.Unit.State (ModuleOrigin (..)) +import GHC.Utils.Error (Severity (..), emptyMessages) +import GHC.Utils.Panic hiding (try) +import qualified GHC.Utils.Panic.Plain as Plain +#endif - +#if MIN_VERSION_ghc(9,0,0) && !MIN_VERSION_ghc(9,2,0) +import GHC.Core.Ppr.TyThing hiding (pprFamInst) +import GHC.Core.TyCo.Rep (scaledThing) +import GHC.Driver.Finder hiding (mkHomeModLocation) +import GHC.Driver.Types +import GHC.Driver.Ways +import GHC.Hs hiding (HsLet, LetStmt) +import GHC.Parser.Lexer +import qualified GHC.Runtime.Linker as Linker +import GHC.Types.Name.Set +import qualified GHC.Driver.Finder as GHC +#endif #if MIN_VERSION_ghc(9,2,0) +import GHC.Data.Bag +import GHC.Core.Multiplicity (scaledThing) +import GHC.Driver.Env +import GHC.Hs (HsModule (..), SrcSpanAnn') +import GHC.Hs.Decls hiding (FunDep) +import GHC.Hs.Doc +import GHC.Hs.Expr +import GHC.Hs.Extension +import GHC.Hs.ImpExp +import GHC.Hs.Pat +import GHC.Hs.Type +import GHC.Hs.Utils hiding (collectHsBindsBinders) +import qualified GHC.Hs.Utils as GHC +import qualified GHC.Linker.Loader as Linker +import GHC.Linker.Types +import GHC.Parser.Lexer hiding (initParserState, getPsMessages) +import GHC.Parser.Annotation (EpAnn (..)) +import GHC.Platform.Ways +import GHC.Runtime.Context (InteractiveImport (..)) +import GHC.Types.Avail (greNamePrintableName) +import GHC.Types.Fixity (LexicalFixity (..), Fixity (..), defaultFixity) +import GHC.Types.Meta +import GHC.Types.Name.Set +import GHC.Types.SourceFile (HscSource (..)) +import GHC.Types.SourceText +import GHC.Types.Target (Target (..), TargetId (..)) +import GHC.Types.TyThing +import GHC.Types.TyThing.Ppr +import GHC.Unit.Finder hiding (mkHomeModLocation) +import GHC.Unit.Home.ModInfo +import GHC.Unit.Module.Graph (mkModuleGraph) +import GHC.Unit.Module.Imported +import GHC.Unit.Module.ModDetails +import GHC.Unit.Module.ModGuts +import GHC.Unit.Module.ModIface (IfaceExport, ModIface (..), + ModIface_ (..), mi_fix) +import GHC.Unit.Module.ModSummary (ModSummary (..)) import Language.Haskell.Syntax hiding (FunDep) #endif -#if MIN_VERSION_ghc(9,3,0) -import GHC.Driver.Env as GHCi -#endif -import Data.Foldable (toList) +#if MIN_VERSION_ghc(9,2,0) && !MIN_VERSION_ghc(9,3,0) +import GHC.Types.SourceFile (SourceModified(..)) +import qualified GHC.Unit.Finder as GHC +#endif #if MIN_VERSION_ghc(9,3,0) +import GHC.Iface.Recomp (CompileReason(..)) +import GHC.Driver.Env.Types (hsc_type_env_vars) +import GHC.Driver.Env (hscUpdateHUG, hscUpdateHPT, hsc_HUG) +import GHC.Driver.Env.KnotVars +import GHC.Iface.Recomp +import GHC.Linker.Types +import GHC.Unit.Module.Graph +import GHC.Driver.Errors.Types +import GHC.Types.Unique.Map +import GHC.Types.Unique +import GHC.Utils.TmpFs +import GHC.Utils.Panic +import GHC.Unit.Finder.Types +import GHC.Unit.Env +import GHC.Driver.Phases +import qualified GHC.Driver.Config.Tidy as GHC +import qualified GHC.Data.Strict as Strict +import GHC.Driver.Env as GHCi import qualified GHC.Unit.Finder as GHC import qualified GHC.Driver.Config.Finder as GHC -#elif MIN_VERSION_ghc(9,2,0) -import qualified GHC.Unit.Finder as GHC -#elif MIN_VERSION_ghc(9,0,0) -import qualified GHC.Driver.Finder as GHC -#else -import qualified Finder as GHC #endif --- NOTE(ozkutuk): Cpp clashes Phase.Cpp, so we hide it. --- Not the greatest solution, but gets the job done --- (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) mkHomeModLocation df mn f = pure $ GHC.mkHomeModLocation (GHC.initFinderOpts df) mn f @@ -1146,12 +1125,13 @@ initTidyOpts = pure #endif -driverNoStop :: StopPhase -driverNoStop = + #if MIN_VERSION_ghc(9,3,0) - NoStop +driverNoStop :: StopPhase +driverNoStop = NoStop #else - StopLn +driverNoStop :: Phase +driverNoStop = StopLn #endif #if !MIN_VERSION_ghc(9,3,0) diff --git a/ghcide/src/Development/IDE/GHC/Compat/Env.hs b/ghcide/src/Development/IDE/GHC/Compat/Env.hs index b134eab3b2..d54cb689fb 100644 --- a/ghcide/src/Development/IDE/GHC/Compat/Env.hs +++ b/ghcide/src/Development/IDE/GHC/Compat/Env.hs @@ -55,24 +55,22 @@ module Development.IDE.GHC.Compat.Env ( import GHC (setInteractiveDynFlags) +#if !MIN_VERSION_ghc(9,0,0) +import DynFlags +import Hooks +import HscTypes as Env +import Module +#endif + #if MIN_VERSION_ghc(9,0,0) -#if MIN_VERSION_ghc(9,2,0) -import GHC.Driver.Backend as Backend -#if MIN_VERSION_ghc(9,3,0) -import GHC.Driver.Env (HscEnv) -#else -import GHC.Driver.Env (HscEnv, hsc_EPS) +import GHC.Driver.Hooks (Hooks) +import GHC.Driver.Session hiding (mkHomeModule) +import GHC.Unit.Types (Module, Unit, UnitId, + mkModule) #endif -import qualified GHC.Driver.Env as Env -import qualified GHC.Driver.Session as Session -import GHC.Platform.Ways hiding (hostFullWays) -import qualified GHC.Platform.Ways as Ways -import GHC.Runtime.Context -import GHC.Unit.Env (UnitEnv) -import GHC.Unit.Home as Home -import GHC.Utils.Logger -import GHC.Utils.TmpFs -#else + +#if MIN_VERSION_ghc(9,0,0) && !MIN_VERSION_ghc(9,2,0) +import qualified Data.Set as Set import qualified GHC.Driver.Session as DynFlags import GHC.Driver.Types (HscEnv, InteractiveContext (..), @@ -82,28 +80,38 @@ import qualified GHC.Driver.Types as Env import GHC.Driver.Ways hiding (hostFullWays) 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 + +#if MIN_VERSION_ghc(9,0,0) && !MIN_VERSION_ghc(9,5,0) import GHC.Unit.Module.Name #endif -import GHC.Unit.Types (Module, UnitId) -#else -import DynFlags -import Hooks -import HscTypes as Env -import Module -#endif -#if MIN_VERSION_ghc(9,0,0) #if !MIN_VERSION_ghc(9,2,0) -import qualified Data.Set as Set +import Data.IORef +#endif + +#if MIN_VERSION_ghc(9,2,0) +import GHC.Driver.Backend as Backend +import qualified GHC.Driver.Env as Env +import qualified GHC.Driver.Session as Session +import GHC.Platform.Ways hiding (hostFullWays) +import qualified GHC.Platform.Ways as Ways +import GHC.Runtime.Context +import GHC.Unit.Env (UnitEnv) +import GHC.Unit.Home as Home +import GHC.Utils.Logger +import GHC.Utils.TmpFs #endif + +#if MIN_VERSION_ghc(9,2,0) && !MIN_VERSION_ghc(9,3,0) +import GHC.Driver.Env (HscEnv, hsc_EPS) #endif -#if !MIN_VERSION_ghc(9,2,0) -import Data.IORef + +#if MIN_VERSION_ghc(9,3,0) +import GHC.Driver.Env (HscEnv) +#endif + +#if MIN_VERSION_ghc(9,5,0) +import Language.Haskell.Syntax.Module.Name #endif #if MIN_VERSION_ghc(9,3,0) diff --git a/ghcide/src/Development/IDE/GHC/Compat/Iface.hs b/ghcide/src/Development/IDE/GHC/Compat/Iface.hs index 5df7eeff2d..0102818887 100644 --- a/ghcide/src/Development/IDE/GHC/Compat/Iface.hs +++ b/ghcide/src/Development/IDE/GHC/Compat/Iface.hs @@ -6,25 +6,30 @@ module Development.IDE.GHC.Compat.Iface ( cannotFindModule, ) where +import Development.IDE.GHC.Compat.Env +import Development.IDE.GHC.Compat.Outputable import GHC -#if MIN_VERSION_ghc(9,3,0) -import GHC.Driver.Session (targetProfile) + +#if !MIN_VERSION_ghc(9,0,0) +import Finder (FindResult) +import qualified Finder +import qualified MkIface #endif -#if MIN_VERSION_ghc(9,2,0) -import qualified GHC.Iface.Load as Iface -import GHC.Unit.Finder.Types (FindResult) -#elif MIN_VERSION_ghc(9,0,0) + +#if MIN_VERSION_ghc(9,0,0) && !MIN_VERSION_ghc(9,2,0) import qualified GHC.Driver.Finder as Finder import GHC.Driver.Types (FindResult) import qualified GHC.Iface.Load as Iface -#else -import Finder (FindResult) -import qualified Finder -import qualified MkIface #endif -import Development.IDE.GHC.Compat.Env -import Development.IDE.GHC.Compat.Outputable +#if MIN_VERSION_ghc(9,2,0) +import qualified GHC.Iface.Load as Iface +import GHC.Unit.Finder.Types (FindResult) +#endif + +#if MIN_VERSION_ghc(9,3,0) +import GHC.Driver.Session (targetProfile) +#endif writeIfaceFile :: HscEnv -> FilePath -> ModIface -> IO () #if MIN_VERSION_ghc(9,3,0) diff --git a/ghcide/src/Development/IDE/GHC/Compat/Logger.hs b/ghcide/src/Development/IDE/GHC/Compat/Logger.hs index 15c6266ec3..7515f0290e 100644 --- a/ghcide/src/Development/IDE/GHC/Compat/Logger.hs +++ b/ghcide/src/Development/IDE/GHC/Compat/Logger.hs @@ -13,16 +13,21 @@ import Development.IDE.GHC.Compat.Core import Development.IDE.GHC.Compat.Env as Env import Development.IDE.GHC.Compat.Outputable +#if !MIN_VERSION_ghc(9,0,0) +import DynFlags +import Outputable (queryQual) +#endif + #if MIN_VERSION_ghc(9,0,0) +import GHC.Driver.Session as DynFlags import GHC.Utils.Outputable +#endif + #if MIN_VERSION_ghc(9,2,0) import GHC.Driver.Env (hsc_logger) import GHC.Utils.Logger as Logger #endif -#else -import DynFlags -import Outputable (queryQual) -#endif + #if MIN_VERSION_ghc(9,3,0) import GHC.Types.Error #endif diff --git a/ghcide/src/Development/IDE/GHC/Compat/Outputable.hs b/ghcide/src/Development/IDE/GHC/Compat/Outputable.hs index 4d64c1652f..795a3e08a7 100644 --- a/ghcide/src/Development/IDE/GHC/Compat/Outputable.hs +++ b/ghcide/src/Development/IDE/GHC/Compat/Outputable.hs @@ -49,28 +49,7 @@ module Development.IDE.GHC.Compat.Outputable ( textDoc, ) where - -#if MIN_VERSION_ghc(9,2,0) -import GHC.Driver.Env -import GHC.Driver.Ppr -import GHC.Driver.Session -#if !MIN_VERSION_ghc(9,3,0) -import GHC.Parser.Errors -#else -import GHC.Parser.Errors.Types -#endif -import qualified GHC.Types.Error as Error -import GHC.Types.Name.Ppr -import GHC.Types.Name.Reader -import GHC.Types.SourceError -import GHC.Types.SrcLoc -import GHC.Unit.State -import GHC.Utils.Error -import GHC.Utils.Outputable as Out hiding - (defaultUserStyle) -import qualified GHC.Utils.Outputable as Out -import GHC.Utils.Panic -#elif MIN_VERSION_ghc(9,0,0) +#if MIN_VERSION_ghc(9,0,0) && !MIN_VERSION_ghc(9,2,0) import GHC.Driver.Session import GHC.Driver.Types as HscTypes import GHC.Types.Name.Reader (GlobalRdrEnv) @@ -80,7 +59,9 @@ import qualified GHC.Utils.Error as Err import GHC.Utils.Outputable as Out hiding (defaultUserStyle) import qualified GHC.Utils.Outputable as Out -#else +#endif + +#if !MIN_VERSION_ghc(9,2,0) import Development.IDE.GHC.Compat.Core (GlobalRdrEnv) import DynFlags import ErrUtils hiding (mkWarnMsg) @@ -91,12 +72,38 @@ import Outputable as Out hiding import qualified Outputable as Out import SrcLoc #endif -#if MIN_VERSION_ghc(9,5,0) -import GHC.Driver.Errors.Types (GhcMessage) + +#if MIN_VERSION_ghc(9,2,0) +import GHC.Driver.Env +import GHC.Driver.Ppr +import GHC.Driver.Session +import qualified GHC.Parser.Errors.Ppr as Ppr +import qualified GHC.Types.Error as Error +import GHC.Types.Name.Ppr +import GHC.Types.Name.Reader +import GHC.Types.SourceError +import GHC.Types.SrcLoc +import GHC.Unit.State +import GHC.Utils.Error hiding (mkWarnMsg) +import GHC.Utils.Outputable as Out hiding + (defaultUserStyle) +import qualified GHC.Utils.Outputable as Out +import GHC.Utils.Panic +#endif + +#if MIN_VERSION_ghc(9,2,0) && !MIN_VERSION_ghc(9,3,0) +import GHC.Parser.Errors #endif + #if MIN_VERSION_ghc(9,3,0) import Data.Maybe import GHC.Driver.Config.Diagnostic +import GHC.Parser.Errors.Types +import GHC.Utils.Logger +#endif + +#if MIN_VERSION_ghc(9,5,0) +import GHC.Driver.Errors.Types (GhcMessage) #endif #if MIN_VERSION_ghc(9,5,0) diff --git a/ghcide/src/Development/IDE/GHC/Compat/Parser.hs b/ghcide/src/Development/IDE/GHC/Compat/Parser.hs index 0f5a61e864..093bd02d71 100644 --- a/ghcide/src/Development/IDE/GHC/Compat/Parser.hs +++ b/ghcide/src/Development/IDE/GHC/Compat/Parser.hs @@ -45,41 +45,55 @@ module Development.IDE.GHC.Compat.Parser ( pattern EpaBlockComment ) where -#if MIN_VERSION_ghc(9,0,0) -#if !MIN_VERSION_ghc(9,2,0) -import qualified GHC.Driver.Types as GHC +import Development.IDE.GHC.Compat.Core +import Development.IDE.GHC.Compat.Util + +#if !MIN_VERSION_ghc(9,0,0) +import qualified ApiAnnotation as Anno +import qualified HscTypes as GHC +import Lexer +import qualified SrcLoc #endif + +#if MIN_VERSION_ghc(9,0,0) import qualified GHC.Parser.Annotation as Anno import qualified GHC.Parser.Lexer as Lexer import GHC.Types.SrcLoc (PsSpan (..)) +#endif + +#if MIN_VERSION_ghc(9,0,0) && !MIN_VERSION_ghc(9,2,0) +import qualified GHC.Driver.Types as GHC +#endif + +#if !MIN_VERSION_ghc(9,2,0) +import qualified Data.Map as Map +import qualified GHC +#endif + #if MIN_VERSION_ghc(9,2,0) -import GHC (EpaCommentTok (..), +import GHC (Anchor (anchor), + EpAnnComments (priorComments), + EpaComment (EpaComment), + EpaCommentTok (..), + epAnnComments, pm_extra_src_files, pm_mod_summary, pm_parsed_source) import qualified GHC -#if MIN_VERSION_ghc(9,3,0) -import qualified GHC.Driver.Config.Parser as Config -#else -import qualified GHC.Driver.Config as Config -#endif -import GHC.Hs (hpm_module, hpm_src_files) +import GHC.Hs (LEpaComment, hpm_module, + hpm_src_files) import GHC.Parser.Lexer hiding (initParserState) #endif -#else -import qualified ApiAnnotation as Anno -import qualified HscTypes as GHC -import Lexer -import qualified SrcLoc + +#if MIN_VERSION_ghc(9,2,0) && !MIN_VERSION_ghc(9,3,0) +import qualified GHC.Driver.Config as Config #endif -import Development.IDE.GHC.Compat.Core -import Development.IDE.GHC.Compat.Util -#if !MIN_VERSION_ghc(9,2,0) -import qualified Data.Map as Map -import qualified GHC +#if MIN_VERSION_ghc(9,3,0) +import qualified GHC.Driver.Config.Parser as Config #endif + #if !MIN_VERSION_ghc(9,0,0) type ParserOpts = DynFlags #elif !MIN_VERSION_ghc(9,2,0) diff --git a/ghcide/src/Development/IDE/GHC/Compat/Plugins.hs b/ghcide/src/Development/IDE/GHC/Compat/Plugins.hs index 90170b9117..60a2e4f063 100644 --- a/ghcide/src/Development/IDE/GHC/Compat/Plugins.hs +++ b/ghcide/src/Development/IDE/GHC/Compat/Plugins.hs @@ -19,30 +19,41 @@ module Development.IDE.GHC.Compat.Plugins ( getPsMessages ) where +import Development.IDE.GHC.Compat.Core +import Development.IDE.GHC.Compat.Env (hscSetFlags, hsc_dflags) +import Development.IDE.GHC.Compat.Outputable as Out +-- 8.10 The import of ‘Development.IDE.GHC.Compat.Outputable’ is redundant except perhaps to import instances from ‘Development.IDE.GHC.Compat.Outputable’ +import Development.IDE.GHC.Compat.Parser as Parser +import Development.IDE.GHC.Compat.Util (Bag) + +#if !MIN_VERSION_ghc(9,0,0) +import qualified DynamicLoading as Loader +import Plugins +#endif + #if MIN_VERSION_ghc(9,0,0) +import GHC.Driver.Plugins (Plugin (..), + PluginWithArgs (..), + StaticPlugin (..), + defaultPlugin, + withPlugins) +import qualified GHC.Runtime.Loader as Loader +#endif + +#if MIN_VERSION_ghc(9,0,0) && !MIN_VERSION_ghc(9,3,0) +import Data.Bifunctor (bimap) +#endif + #if MIN_VERSION_ghc(9,2,0) -import qualified GHC.Driver.Env as Env +import qualified GHC.Driver.Env as Env #endif -import GHC.Driver.Plugins (Plugin (..), - PluginWithArgs (..), - StaticPlugin (..), - defaultPlugin, withPlugins) + #if MIN_VERSION_ghc(9,3,0) -import GHC.Driver.Plugins (ParsedResult (..), - PsMessages (..), - staticPlugins) -import qualified GHC.Parser.Lexer as Lexer -#else -import Data.Bifunctor (bimap) +import GHC.Driver.Plugins (ParsedResult (..), + PsMessages (..), + staticPlugins) +import qualified GHC.Parser.Lexer as Lexer #endif -import qualified GHC.Runtime.Loader as Loader -#else -import qualified DynamicLoading as Loader -import Plugins -#endif -import Development.IDE.GHC.Compat.Core -import Development.IDE.GHC.Compat.Env (hscSetFlags, hsc_dflags) -import Development.IDE.GHC.Compat.Parser as Parser #if !MIN_VERSION_ghc(9,3,0) diff --git a/ghcide/src/Development/IDE/GHC/Compat/Units.hs b/ghcide/src/Development/IDE/GHC/Compat/Units.hs index 7b4811e870..58b21168ca 100644 --- a/ghcide/src/Development/IDE/GHC/Compat/Units.hs +++ b/ghcide/src/Development/IDE/GHC/Compat/Units.hs @@ -54,69 +54,76 @@ module Development.IDE.GHC.Compat.Units ( ) where import Control.Monad -import qualified Data.List.NonEmpty as NE -import qualified Data.Map.Strict as Map -#if MIN_VERSION_ghc(9,3,0) -import GHC.Unit.Home.ModInfo -#endif -#if MIN_VERSION_ghc(9,0,0) -#if MIN_VERSION_ghc(9,2,0) -import qualified GHC.Data.ShortText as ST -#if !MIN_VERSION_ghc(9,3,0) -import GHC.Driver.Env (hsc_unit_dbs) -#endif -import GHC.Driver.Ppr -import GHC.Unit.Env -import GHC.Unit.External -import GHC.Unit.Finder hiding (findImportedModule) -#else -import GHC.Driver.Types -#endif -import qualified GHC.Driver.Session as DynFlags -import GHC.Types.Unique.Set -import qualified GHC.Unit.Info as UnitInfo -import GHC.Unit.State (LookupResult, UnitInfo, - UnitState (unitInfoMap)) -import qualified GHC.Unit.State as State -import GHC.Unit.Types hiding (moduleUnit, toUnitId) -import qualified GHC.Unit.Types as Unit -import GHC.Utils.Outputable -#else +-- 8.10 The import of ‘Control.Monad’ is redundant except perhaps to import instances from ‘Control.Monad’ +import qualified Data.List.NonEmpty as NE +-- 8.10 The qualified import of ‘Data.List.NonEmpty’ is redundant except perhaps to import instances from ‘Data.List.NonEmpty’ +import qualified Data.Map.Strict as Map +-- 8.10 The qualified import of ‘Data.Map.Strict’ is redundant except perhaps to import instances from ‘Data.Map.Strict’ +import Data.Either +import Data.Version +import Development.IDE.GHC.Compat.Core +import Development.IDE.GHC.Compat.Env +import Development.IDE.GHC.Compat.Outputable +import qualified GHC +-- 8.10 The qualified import of ‘GHC’ is redundant except perhaps to import instances from ‘GHC’ + +#if !MIN_VERSION_ghc(9,0,0) import qualified DynFlags import FastString -import GhcPlugins (SDoc, showSDocForUser) +import qualified Finder as GHC import HscTypes -import Module hiding (moduleUnitId) +import Module hiding (moduleUnitId) import qualified Module -import Packages (InstalledPackageInfo (haddockInterfaces, packageName), - LookupResult, PackageConfig, - PackageConfigMap, - PackageState, - getPackageConfigMap, - lookupPackage') +import Packages (InstalledPackageInfo (haddockInterfaces, packageName), + LookupResult, + PackageConfig, + PackageConfigMap, + PackageState, + getPackageConfigMap, + lookupPackage') import qualified Packages #endif -import Development.IDE.GHC.Compat.Core -import Development.IDE.GHC.Compat.Env +#if MIN_VERSION_ghc(9,0,0) +import GHC.Data.FastString +import qualified GHC.Driver.Session as DynFlags +import GHC.Types.Unique.Set +import qualified GHC.Unit.Info as UnitInfo +import GHC.Unit.State (LookupResult, UnitInfo, + UnitState (unitInfoMap)) +import qualified GHC.Unit.State as State +import GHC.Unit.Types hiding (moduleUnit, + toUnitId) +import qualified GHC.Unit.Types as Unit +import GHC.Utils.Outputable +#endif + #if MIN_VERSION_ghc(9,0,0) && !MIN_VERSION_ghc(9,2,0) -import Data.Map (Map) +import Data.Map (Map) +import qualified GHC.Driver.Finder as GHC +import GHC.Driver.Types #endif -import Data.Either -import Data.Version -import qualified GHC -#if MIN_VERSION_ghc(9,3,0) -import GHC.Types.PkgQual (PkgQual (NoPkgQual)) +#if MIN_VERSION_ghc(9,2,0) +import qualified GHC.Data.ShortText as ST +import GHC.Driver.Ppr +import GHC.Unit.Env +import GHC.Unit.External +import GHC.Unit.Finder hiding + (findImportedModule) +import qualified GHC.Unit.Finder as GHC #endif -#if MIN_VERSION_ghc(9,1,0) -import qualified GHC.Unit.Finder as GHC -#elif MIN_VERSION_ghc(9,0,0) -import qualified GHC.Driver.Finder as GHC -#else -import qualified Finder as GHC + +#if MIN_VERSION_ghc(9,2,0) && !MIN_VERSION_ghc(9,3,0) +import GHC.Driver.Env (hsc_unit_dbs) #endif +#if MIN_VERSION_ghc(9,3,0) +import GHC.Types.PkgQual (PkgQual (NoPkgQual)) +import GHC.Unit.Home.ModInfo +#endif + + #if MIN_VERSION_ghc(9,0,0) type PreloadUnitClosure = UniqSet UnitId #if MIN_VERSION_ghc(9,2,0) diff --git a/ghcide/src/Development/IDE/GHC/Compat/Util.hs b/ghcide/src/Development/IDE/GHC/Compat/Util.hs index 22b278f36e..2b4344a90c 100644 --- a/ghcide/src/Development/IDE/GHC/Compat/Util.hs +++ b/ghcide/src/Development/IDE/GHC/Compat/Util.hs @@ -69,6 +69,23 @@ module Development.IDE.GHC.Compat.Util ( atEnd, ) where +#if !MIN_VERSION_ghc(9,0,0) +import Bag +import BooleanFormula +import EnumSet +import qualified Exception +import FastString +import Fingerprint +import Maybes +import Outputable (pprHsString) +import Pair +import Panic hiding (try) +import StringBuffer +import UniqDFM +import Unique +import Util +#endif + #if MIN_VERSION_ghc(9,0,0) import Control.Exception.Safe (MonadCatch, catch, try) import GHC.Data.Bag @@ -82,23 +99,9 @@ import GHC.Data.StringBuffer import GHC.Types.Unique import GHC.Types.Unique.DFM import GHC.Utils.Fingerprint +import GHC.Utils.Misc import GHC.Utils.Outputable (pprHsString) import GHC.Utils.Panic hiding (try) -#else -import Bag -import BooleanFormula -import EnumSet -import qualified Exception -import FastString -import Fingerprint -import Maybes -import Outputable (pprHsString) -import Pair -import Panic hiding (try) -import StringBuffer -import UniqDFM -import Unique -import Util #endif #if MIN_VERSION_ghc(9,3,0) diff --git a/ghcide/src/Development/IDE/GHC/CoreFile.hs b/ghcide/src/Development/IDE/GHC/CoreFile.hs index 715951f2bf..12d888b179 100644 --- a/ghcide/src/Development/IDE/GHC/CoreFile.hs +++ b/ghcide/src/Development/IDE/GHC/CoreFile.hs @@ -20,9 +20,21 @@ import Data.IORef import Data.List (isPrefixOf) import Data.Maybe import qualified Data.Text as T +import Development.IDE.GHC.Compat +import qualified Development.IDE.GHC.Compat.Util as Util import GHC.Fingerprint -import Development.IDE.GHC.Compat +#if !MIN_VERSION_ghc(9,0,0) +import Binary +import BinFingerprint (fingerprintBinMem) +import BinIface +import CoreSyn +import HscTypes +import IfaceEnv +import MkId +import TcIface +import ToIface +#endif #if MIN_VERSION_ghc(9,0,0) import GHC.Core @@ -33,29 +45,16 @@ import GHC.Iface.Recomp.Binary (fingerprintBinMem) import GHC.IfaceToCore import GHC.Types.Id.Make import GHC.Utils.Binary +#endif -#if MIN_VERSION_ghc(9,2,0) -import GHC.Types.TypeEnv -#else +#if MIN_VERSION_ghc(9,0,0) && !MIN_VERSION_ghc(9,2,0) import GHC.Driver.Types #endif -#else -import Binary -import BinFingerprint (fingerprintBinMem) -import BinIface -import CoreSyn -import HscTypes -import IdInfo -import IfaceEnv -import MkId -import TcIface -import ToIface -import Unique -import Var +#if MIN_VERSION_ghc(9,2,0) +import GHC.Types.TypeEnv #endif -import qualified Development.IDE.GHC.Compat.Util as Util -- | Initial ram buffer to allocate for writing interface files initBinMemSize :: Int diff --git a/ghcide/src/Development/IDE/GHC/Orphans.hs b/ghcide/src/Development/IDE/GHC/Orphans.hs index b34fa77d1e..0791b823ec 100644 --- a/ghcide/src/Development/IDE/GHC/Orphans.hs +++ b/ghcide/src/Development/IDE/GHC/Orphans.hs @@ -8,42 +8,46 @@ -- | Orphan instances for GHC. -- Note that the 'NFData' instances may not be law abiding. module Development.IDE.GHC.Orphans() where - -#if MIN_VERSION_ghc(9,2,0) -import GHC.Parser.Annotation -#endif -#if MIN_VERSION_ghc(9,0,0) -import GHC.Data.Bag -import GHC.Data.FastString -import qualified GHC.Data.StringBuffer as SB -import GHC.Types.Name.Occurrence -import GHC.Types.SrcLoc -import GHC.Unit.Info -#else -import Bag -import GhcPlugins -import qualified StringBuffer as SB -import Unique (getKey) -#endif - - import Development.IDE.GHC.Compat import Development.IDE.GHC.Util import Control.DeepSeq import Data.Aeson import Data.Bifunctor (Bifunctor (..)) +-- 8.10 The import of ‘Data.Bifunctor’ is redundant except perhaps to import instances from ‘Data.Bifunctor’ import Data.Hashable import Data.String (IsString (fromString)) import Data.Text (unpack) + +#if !MIN_VERSION_ghc(9,0,0) +import Bag +import ByteCodeTypes +import GhcPlugins +import qualified StringBuffer as SB +import Unique (getKey) +#endif + #if MIN_VERSION_ghc(9,0,0) +import GHC (ModuleGraph) import GHC.ByteCode.Types -#else -import ByteCodeTypes +import GHC.Data.Bag +import GHC.Data.FastString +import qualified GHC.Data.StringBuffer as SB +import GHC.Types.Name.Occurrence +import GHC.Types.SrcLoc +import GHC.Types.Unique (getKey) +import GHC.Unit.Info +import GHC.Utils.Outputable +#endif + +#if MIN_VERSION_ghc(9,2,0) +import GHC.Parser.Annotation #endif + #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 diff --git a/ghcide/src/Development/IDE/GHC/Util.hs b/ghcide/src/Development/IDE/GHC/Util.hs index 29ff450d64..7f666d1f03 100644 --- a/ghcide/src/Development/IDE/GHC/Util.hs +++ b/ghcide/src/Development/IDE/GHC/Util.hs @@ -30,25 +30,6 @@ module Development.IDE.GHC.Util( getExtensions ) where -#if MIN_VERSION_ghc(9,2,0) -import GHC.Data.EnumSet -import GHC.Data.FastString -import GHC.Data.StringBuffer -import GHC.Driver.Env hiding (hscSetFlags) -import GHC.Driver.Monad -import GHC.Driver.Session hiding (ExposePackage) -import GHC.Parser.Lexer -import GHC.Runtime.Context -import GHC.Types.Name.Occurrence -import GHC.Types.Name.Reader -import GHC.Types.SrcLoc -import GHC.Unit.Module.ModDetails -import GHC.Unit.Module.ModGuts -import GHC.Utils.Fingerprint -import GHC.Utils.Outputable -#else -import Development.IDE.GHC.Compat.Util -#endif import Control.Concurrent import Control.Exception as E import Data.Binary.Put (Put, runPut) @@ -56,13 +37,22 @@ import qualified Data.ByteString as BS import Data.ByteString.Internal (ByteString (..)) import qualified Data.ByteString.Internal as BS import qualified Data.ByteString.Lazy as LBS +import Data.Data (Data) +-- 8.10 The import of ‘Data.Data’ is redundant except perhaps to import instances from ‘Data.Data’ import Data.IORef import Data.List.Extra import Data.Maybe import qualified Data.Text as T import qualified Data.Text.Encoding as T import qualified Data.Text.Encoding.Error as T +import Data.Time.Clock.POSIX (POSIXTime, getCurrentTime, + utcTimeToPOSIXSeconds) +-- 8.10 The import of ‘Data.Time.Clock.POSIX’ is redundant except perhaps to import instances from ‘Data.Time.Clock.POSIX’ import Data.Typeable +import qualified Data.Unique as U +-- 8.10 The qualified import of ‘Data.Unique’ is redundant except perhaps to import instances from ‘Data.Unique’ +import Debug.Trace +-- 8.10 The import of ‘Debug.Trace’ is redundant except perhaps to import instances from ‘Debug.Trace’ import Development.IDE.GHC.Compat as GHC import qualified Development.IDE.GHC.Compat.Parser as Compat import qualified Development.IDE.GHC.Compat.Units as Compat @@ -77,10 +67,38 @@ import GHC.IO.Encoding import GHC.IO.Exception import GHC.IO.Handle.Internals import GHC.IO.Handle.Types +import GHC.Stack +-- 8.10 The import of ‘GHC.Stack’ is redundant except perhaps to import instances from ‘GHC.Stack’ import Ide.PluginUtils (unescape) +import System.Environment.Blank (getEnvDefault) +-- 8.10 The import of ‘System.Environment.Blank’ is redundant except perhaps to import instances from ‘System.Environment.Blank’ import System.FilePath +import System.IO.Unsafe +-- 8.10 The import of ‘System.IO.Unsafe’ is redundant except perhaps to import instances from ‘System.IO.Unsafe’ +import Text.Printf +-- 8.10 The import of ‘Text.Printf’ is redundant except perhaps to import instances from ‘Text.Printf’ +#if !MIN_VERSION_ghc(9,2,0) +import Development.IDE.GHC.Compat.Util +#endif +#if MIN_VERSION_ghc(9,2,0) +import GHC.Data.EnumSet +import GHC.Data.FastString +import GHC.Data.StringBuffer +import GHC.Driver.Env hiding (hscSetFlags) +import GHC.Driver.Monad +import GHC.Driver.Session hiding (ExposePackage) +import GHC.Parser.Lexer +import GHC.Runtime.Context +import GHC.Types.Name.Occurrence +import GHC.Types.Name.Reader +import GHC.Types.SrcLoc +import GHC.Unit.Module.ModDetails +import GHC.Unit.Module.ModGuts +import GHC.Utils.Fingerprint +import GHC.Utils.Outputable +#endif ---------------------------------------------------------------------- -- GHC setup diff --git a/ghcide/src/Development/IDE/Import/FindImports.hs b/ghcide/src/Development/IDE/Import/FindImports.hs index 5f7f1c4cd1..3fcf175c41 100644 --- a/ghcide/src/Development/IDE/Import/FindImports.hs +++ b/ghcide/src/Development/IDE/Import/FindImports.hs @@ -15,6 +15,7 @@ module Development.IDE.Import.FindImports import Control.DeepSeq import Development.IDE.GHC.Compat as Compat +import Development.IDE.GHC.Compat.Util import Development.IDE.GHC.Error as ErrUtils import Development.IDE.GHC.Orphans () import Development.IDE.Types.Diagnostics @@ -26,6 +27,7 @@ import Control.Monad.IO.Class import Data.List (isSuffixOf) import Data.Maybe import System.FilePath + #if MIN_VERSION_ghc(9,3,0) import GHC.Types.PkgQual import GHC.Unit.State diff --git a/ghcide/src/Development/IDE/LSP/Outline.hs b/ghcide/src/Development/IDE/LSP/Outline.hs index 4b0a9f4754..20a039d8ff 100644 --- a/ghcide/src/Development/IDE/LSP/Outline.hs +++ b/ghcide/src/Development/IDE/LSP/Outline.hs @@ -12,8 +12,10 @@ where import Control.Monad.IO.Class import Data.Functor import Data.Foldable (toList) +--8.10 The import of ‘Data.Foldable’ is redundant except perhaps to import instances from ‘Data.Foldable’ import Data.Generics hiding (Prefix) import Data.Maybe +import qualified Data.Text as T import Development.IDE.Core.Rules import Development.IDE.Core.Shake import Development.IDE.GHC.Compat @@ -28,6 +30,7 @@ import Language.LSP.Protocol.Types (DocumentSymbol (..), TextDocumentIdentifier (TextDocumentIdentifier), type (|?) (InL, InR), uriToFilePath) import Language.LSP.Protocol.Message + #if MIN_VERSION_ghc(9,2,0) import Data.List.NonEmpty (nonEmpty) #endif diff --git a/ghcide/src/Development/IDE/Main.hs b/ghcide/src/Development/IDE/Main.hs index 09e0c8cca3..92acfcbafc 100644 --- a/ghcide/src/Development/IDE/Main.hs +++ b/ghcide/src/Development/IDE/Main.hs @@ -29,8 +29,11 @@ import Data.List.Extra (intercalate, import Data.Maybe (catMaybes, isJust) import qualified Data.Text as T import Development.IDE (Action, + GhcVersion (..), Priority (Debug, Error), - Rules, hDuplicateTo') + Rules, ghcVersion, + hDuplicateTo') +-- 8.10 The import of ‘GhcVersion, ghcVersion’from module ‘Development.IDE’ is redundant import Development.IDE.Core.Debouncer (Debouncer, newAsyncDebouncer) import Development.IDE.Core.FileStore (isWatchSupported) @@ -74,6 +77,15 @@ import Development.IDE.Session (SessionLoadingOptions import qualified Development.IDE.Session as Session import Development.IDE.Types.Location (NormalizedUri, toNormalizedFilePath') +import Ide.Logger (Logger, + Pretty (pretty), + Priority (Info, Warning), + Recorder, + WithPriority, + cmapWithPrio, + logWith, nest, vsep, + (<+>)) +-- 8.10 The import of ‘Warning’ from module ‘Ide.Logger’ is redundant import Development.IDE.Types.Monitoring (Monitoring) import Development.IDE.Types.Options (IdeGhcSession, IdeOptions (optCheckParents, optCheckProject, optReportProgress, optRunSubset), @@ -88,14 +100,6 @@ import GHC.IO.Encoding (setLocaleEncoding) import GHC.IO.Handle (hDuplicate) import HIE.Bios.Cradle (findCradle) import qualified HieDb.Run as HieDb -import Ide.Logger (Logger, - Pretty (pretty), - Priority (Info), - Recorder, - WithPriority, - cmapWithPrio, - logWith, nest, vsep, - (<+>)) import Ide.Plugin.Config (CheckParents (NeverCheck), Config, checkParents, checkProject, diff --git a/ghcide/src/Development/IDE/Monitoring/EKG.hs b/ghcide/src/Development/IDE/Monitoring/EKG.hs index e4d9f6d0ae..26414fdf04 100644 --- a/ghcide/src/Development/IDE/Monitoring/EKG.hs +++ b/ghcide/src/Development/IDE/Monitoring/EKG.hs @@ -3,6 +3,7 @@ module Development.IDE.Monitoring.EKG(monitoring) where import Development.IDE.Types.Monitoring (Monitoring (..)) import Ide.Logger (Logger) + #ifdef MONITORING_EKG import Control.Concurrent (killThread) import Control.Concurrent.Async (async, waitCatch) diff --git a/ghcide/src/Development/IDE/Plugin/Completions.hs b/ghcide/src/Development/IDE/Plugin/Completions.hs index 79c8a9cade..757f94d46b 100644 --- a/ghcide/src/Development/IDE/Plugin/Completions.hs +++ b/ghcide/src/Development/IDE/Plugin/Completions.hs @@ -15,6 +15,8 @@ import Control.Lens ((&), (.~), (?~)) import Control.Monad.IO.Class import Control.Monad.Trans.Except (ExceptT (ExceptT), withExceptT) +import Data.Aeson +-- 8.10 The import of ‘Data.Aeson’ is redundant except perhaps to import instances from ‘Data.Aeson’ import qualified Data.HashMap.Strict as Map import qualified Data.HashSet as Set import Data.Maybe @@ -53,6 +55,7 @@ import Text.Fuzzy.Parallel (Scored (..)) import Development.IDE.Core.Rules (usePropertyAction) import qualified GHC.LanguageExtensions as LangExt +-- 8.10 The qualified import of ‘GHC.LanguageExtensions’ is redundant except perhaps to import instances from ‘GHC.LanguageExtensions’ import qualified Ide.Plugin.Config as Config data Log = LogShake Shake.Log deriving Show diff --git a/ghcide/src/Development/IDE/Plugin/Completions/Logic.hs b/ghcide/src/Development/IDE/Plugin/Completions/Logic.hs index eac9ac5e35..ad778941ce 100644 --- a/ghcide/src/Development/IDE/Plugin/Completions/Logic.hs +++ b/ghcide/src/Development/IDE/Plugin/Completions/Logic.hs @@ -24,21 +24,28 @@ import Data.List.Extra as List hiding import qualified Data.Map as Map import Data.Row -import Data.Maybe (fromMaybe, isJust, - isNothing, +import Data.Maybe (catMaybes, fromMaybe, + isJust, isNothing, listToMaybe, mapMaybe) +-- 8.10 The import of ‘catMaybes’ from module ‘Data.Maybe’ is redundant import qualified Data.Text as T import qualified Text.Fuzzy.Parallel as Fuzzy import Control.Monad import Data.Aeson (ToJSON (toJSON)) import Data.Function (on) +import Data.Functor +-- 8.10 The import of ‘Data.Functor’ is redundant except perhaps to import instances from ‘Data.Functor’ +import qualified Data.HashMap.Strict as HM +-- 8.10 The qualified import of ‘Data.HashMap.Strict’ is redundant except perhaps to import instances from ‘Data.HashMap.Strict’ import qualified Data.HashSet as HashSet import Data.Monoid (First (..)) import Data.Ord (Down (Down)) import qualified Data.Set as Set +import Development.IDE.Core.Compile +-- 8.10 The import of ‘Development.IDE.Core.Compile’ is redundant except perhaps to import instances from ‘Development.IDE.Core.Compile’ import Development.IDE.Core.PositionMapping import Development.IDE.GHC.Compat hiding (ppr) import qualified Development.IDE.GHC.Compat as GHC @@ -47,16 +54,15 @@ import Development.IDE.GHC.CoreFile (occNamePrefixes) import Development.IDE.GHC.Error import Development.IDE.GHC.Util import Development.IDE.Plugin.Completions.Types +import Development.IDE.Spans.Common +-- 8.10 The import of ‘Development.IDE.Spans.Common’ is redundant except perhaps to import instances from ‘Development.IDE.Spans.Common’ +import Development.IDE.Spans.Documentation +-- 8.10 The import of ‘Development.IDE.Spans.Documentation’ is redundant except perhaps to import instances from ‘Development.IDE.Spans.Documentation’ import Development.IDE.Spans.LocalBindings import Development.IDE.Types.Exports +import Development.IDE.Types.HscEnvEq +-- 8.10 The import of ‘Development.IDE.Types.HscEnvEq’ is redundant except perhaps to import instances from ‘Development.IDE.Types.HscEnvEq’ import Development.IDE.Types.Options - -#if MIN_VERSION_ghc(9,2,0) -import GHC.Plugins (Depth (AllTheWay), - mkUserStyle, - neverQualify, - sdocStyle) -#endif import Ide.PluginUtils (mkLspCommand) import Ide.Types (CommandId (..), IdePlugins (..), @@ -72,6 +78,15 @@ import Development.IDE import Development.IDE.Spans.AtPoint (pointCommand) +#if MIN_VERSION_ghc(9,2,0) +import GHC.Plugins (Depth (AllTheWay), + defaultSDocContext, + mkUserStyle, + neverQualify, + renderWithContext, + sdocStyle) +#endif + #if MIN_VERSION_ghc(9,5,0) import Language.Haskell.Syntax.Basic #endif diff --git a/ghcide/src/Development/IDE/Plugin/Completions/Types.hs b/ghcide/src/Development/IDE/Plugin/Completions/Types.hs index 048a3f1b4d..93f908d2b4 100644 --- a/ghcide/src/Development/IDE/Plugin/Completions/Types.hs +++ b/ghcide/src/Development/IDE/Plugin/Completions/Types.hs @@ -19,17 +19,23 @@ import Data.Text (Text) import Data.Typeable (Typeable) import Development.IDE.GHC.Compat import Development.IDE.Graph (RuleResult) -import Development.IDE.Spans.Common () +import Development.IDE.Spans.Common +-- 8.10 The import of ‘Development.IDE.Spans.Common’ is redundant except perhaps to import instances from ‘Development.IDE.Spans.Common’ import GHC.Generics (Generic) import Ide.Plugin.Properties import Language.LSP.Protocol.Types (CompletionItemKind (..), Uri) import qualified Language.LSP.Protocol.Types as J + +#if !MIN_VERSION_ghc(9,0,0) +import qualified OccName as Occ +#endif + #if MIN_VERSION_ghc(9,0,0) import qualified GHC.Types.Name.Occurrence as Occ -#else -import qualified OccName as Occ #endif + + -- | Produce completions info for a file type instance RuleResult LocalCompletions = CachedCompletions type instance RuleResult NonLocalCompletions = CachedCompletions diff --git a/ghcide/src/Development/IDE/Plugin/Test.hs b/ghcide/src/Development/IDE/Plugin/Test.hs index 72a1d5b912..84c5c124e1 100644 --- a/ghcide/src/Development/IDE/Plugin/Test.hs +++ b/ghcide/src/Development/IDE/Plugin/Test.hs @@ -46,6 +46,8 @@ import Development.IDE.Types.Action import Development.IDE.Types.HscEnvEq (HscEnvEq (hscEnv)) import Development.IDE.Types.Location (fromUri) import GHC.Generics (Generic) +import Ide.Plugin.Config (CheckParents) +-- 8.10 The import of ‘Ide.Plugin.Config’ is redundant except perhaps to import instances from ‘Ide.Plugin.Config’ import Ide.Plugin.Error import Ide.Types import Language.LSP.Protocol.Message diff --git a/ghcide/src/Development/IDE/Plugin/TypeLenses.hs b/ghcide/src/Development/IDE/Plugin/TypeLenses.hs index 5ce2529fe8..642c5dd457 100644 --- a/ghcide/src/Development/IDE/Plugin/TypeLenses.hs +++ b/ghcide/src/Development/IDE/Plugin/TypeLenses.hs @@ -19,7 +19,8 @@ import Control.Monad (mzero) import Control.Monad.Extra (whenMaybe) import Control.Monad.IO.Class (MonadIO (liftIO)) import Control.Monad.Trans.Class (MonadTrans (lift)) -import Data.Aeson.Types (toJSON) +import Data.Aeson.Types (Value, toJSON) +-- 8.10 The import of ‘Value’ from module ‘Data.Aeson.Types’ is redundant import qualified Data.Aeson.Types as A import Data.List (find) import qualified Data.Map as Map diff --git a/ghcide/src/Development/IDE/Spans/Documentation.hs b/ghcide/src/Development/IDE/Spans/Documentation.hs index 390c56f82d..a66457d6f8 100644 --- a/ghcide/src/Development/IDE/Spans/Documentation.hs +++ b/ghcide/src/Development/IDE/Spans/Documentation.hs @@ -29,11 +29,12 @@ import Development.IDE.GHC.Compat.Util import Development.IDE.GHC.Error import Development.IDE.GHC.Util (printOutputable) import Development.IDE.Spans.Common +import Language.LSP.Protocol.Types (filePathToUri, getUri) import System.Directory import System.FilePath -import Language.LSP.Protocol.Types (filePathToUri, getUri) #if MIN_VERSION_ghc(9,3,0) +import GHC.Types.Unique.Map #endif mkDocMap diff --git a/ghcide/src/Development/IDE/Spans/Pragmas.hs b/ghcide/src/Development/IDE/Spans/Pragmas.hs index 16ec9858db..a88fca987d 100644 --- a/ghcide/src/Development/IDE/Spans/Pragmas.hs +++ b/ghcide/src/Development/IDE/Spans/Pragmas.hs @@ -18,14 +18,15 @@ import qualified Data.Text as Text import Development.IDE (srcSpanToRange, IdeState, NormalizedFilePath, GhcSession (..), getFileContents, hscEnv, runAction) import Development.IDE.GHC.Compat import Development.IDE.GHC.Compat.Util -import qualified Language.LSP.Protocol.Types as LSP -import Control.Monad.IO.Class (MonadIO (..)) -import Control.Monad.Trans.Except (ExceptT) -import Ide.Plugin.Error (PluginError) -import Ide.Types (PluginId(..)) -import qualified Data.Text as T -import Development.IDE.Core.PluginUtils -import qualified Language.LSP.Protocol.Lens as L +import qualified Language.LSP.Protocol.Types as LSP +import Control.Monad.IO.Class (MonadIO (..)) +import Control.Monad.Trans.Except (ExceptT) +import Ide.Plugin.Error (PluginError) +import Ide.Types (PluginId(..)) +import qualified Data.Text as T +import Development.IDE.Core.PluginUtils +import qualified Language.LSP.Protocol.Lens as L + getNextPragmaInfo :: DynFlags -> Maybe Text -> NextPragmaInfo getNextPragmaInfo dynFlags sourceText = if | Just sourceText <- sourceText diff --git a/ghcide/src/Development/IDE/Types/Exports.hs b/ghcide/src/Development/IDE/Types/Exports.hs index 3a507eb3c0..35f88a7a69 100644 --- a/ghcide/src/Development/IDE/Types/Exports.hs +++ b/ghcide/src/Development/IDE/Types/Exports.hs @@ -23,15 +23,24 @@ module Development.IDE.Types.Exports import Control.DeepSeq (NFData (..), force, ($!!)) import Control.Monad +import Data.Bifunctor (Bifunctor (second)) +-- 8.10 The import of ‘Data.Bifunctor’ is redundant except perhaps to import instances from ‘Data.Bifunctor’ import Data.Char (isUpper) import Data.Hashable (Hashable) +import Data.HashMap.Strict (HashMap, elems) +-- 8.10 The import of ‘Data.HashMap.Strict’ is redundant except perhaps to import instances from ‘Data.HashMap.Strict’ +import qualified Data.HashMap.Strict as Map +-- 8.10 The qualified import of ‘Data.HashMap.Strict’ is redundant except perhaps to import instances from ‘Data.HashMap.Strict’ import Data.HashSet (HashSet) import qualified Data.HashSet as Set -import Data.List (isSuffixOf) +import Data.List (foldl', isSuffixOf) +-- 8.10 The import of ‘foldl'’ from module ‘Data.List’ is redundant import Data.Text (Text, uncons) import Data.Text.Encoding (decodeUtf8, encodeUtf8) import Development.IDE.GHC.Compat import Development.IDE.GHC.Orphans () +import Development.IDE.GHC.Util +-- 8.10 The import of ‘Development.IDE.GHC.Util’ is redundant except perhaps to import instances from ‘Development.IDE.GHC.Util’ import GHC.Generics (Generic) import HieDb From 920a184843dd1c047eba66564fed60acad7817db Mon Sep 17 00:00:00 2001 From: Nathan Maxson Date: Fri, 11 Aug 2023 20:20:53 +0300 Subject: [PATCH 03/18] Fix build problems --- ghcide/src/Development/IDE/GHC/Compat/Core.hs | 9 +++------ ghcide/src/Development/IDE/GHC/Compat/Outputable.hs | 2 +- 2 files changed, 4 insertions(+), 7 deletions(-) diff --git a/ghcide/src/Development/IDE/GHC/Compat/Core.hs b/ghcide/src/Development/IDE/GHC/Compat/Core.hs index b883ae78ca..ec4d98a442 100644 --- a/ghcide/src/Development/IDE/GHC/Compat/Core.hs +++ b/ghcide/src/Development/IDE/GHC/Compat/Core.hs @@ -1097,7 +1097,6 @@ makeSimpleDetails hsc_env = hsc_env #endif -mkIfaceTc :: HscEnv -> GHC.SafeHaskellMode -> ModDetails -> ModSummary -> TcGblEnv -> IO ModIface mkIfaceTc hsc_env sf details ms tcGblEnv = GHC.mkIfaceTc hsc_env sf details #if MIN_VERSION_ghc(9,3,0) @@ -1125,13 +1124,11 @@ initTidyOpts = pure #endif - +driverNoStop = #if MIN_VERSION_ghc(9,3,0) -driverNoStop :: StopPhase -driverNoStop = NoStop + NoStop #else -driverNoStop :: Phase -driverNoStop = StopLn + StopLn #endif #if !MIN_VERSION_ghc(9,3,0) diff --git a/ghcide/src/Development/IDE/GHC/Compat/Outputable.hs b/ghcide/src/Development/IDE/GHC/Compat/Outputable.hs index 795a3e08a7..c87b5bb192 100644 --- a/ghcide/src/Development/IDE/GHC/Compat/Outputable.hs +++ b/ghcide/src/Development/IDE/GHC/Compat/Outputable.hs @@ -61,7 +61,7 @@ import GHC.Utils.Outputable as Out hiding import qualified GHC.Utils.Outputable as Out #endif -#if !MIN_VERSION_ghc(9,2,0) +#if !MIN_VERSION_ghc(9,0,0) import Development.IDE.GHC.Compat.Core (GlobalRdrEnv) import DynFlags import ErrUtils hiding (mkWarnMsg) From aa72411fea2e683e68ae5b00dc5c228b78d7fa8c Mon Sep 17 00:00:00 2001 From: Nathan Maxson Date: Mon, 14 Aug 2023 18:46:16 +0300 Subject: [PATCH 04/18] Remove all redundant imports --- .../session-loader/Development/IDE/Session.hs | 7 ++- ghcide/src/Development/IDE/Core/Compile.hs | 46 ++++++++++--------- ghcide/src/Development/IDE/Core/FileStore.hs | 34 ++++++-------- .../Development/IDE/Core/IdeConfiguration.hs | 6 +-- .../src/Development/IDE/Core/Preprocessor.hs | 1 - ghcide/src/Development/IDE/Core/Rules.hs | 27 ++++------- ghcide/src/Development/IDE/Core/Shake.hs | 14 +++--- ghcide/src/Development/IDE/GHC/CPP.hs | 9 ++-- ghcide/src/Development/IDE/GHC/Compat.hs | 31 ++++++------- ghcide/src/Development/IDE/GHC/Compat/Core.hs | 17 +------ ghcide/src/Development/IDE/GHC/Compat/Env.hs | 4 +- .../src/Development/IDE/GHC/Compat/Logger.hs | 5 +- .../Development/IDE/GHC/Compat/Outputable.hs | 3 +- .../src/Development/IDE/GHC/Compat/Parser.hs | 10 +--- .../src/Development/IDE/GHC/Compat/Plugins.hs | 13 ++++-- .../src/Development/IDE/GHC/Compat/Units.hs | 30 ++++++------ ghcide/src/Development/IDE/GHC/Compat/Util.hs | 5 +- ghcide/src/Development/IDE/GHC/Orphans.hs | 12 ++--- ghcide/src/Development/IDE/GHC/Util.hs | 28 ----------- .../src/Development/IDE/Import/FindImports.hs | 5 +- .../Development/IDE/LSP/HoverDefinition.hs | 4 +- ghcide/src/Development/IDE/LSP/Outline.hs | 10 ++-- ghcide/src/Development/IDE/Main.hs | 23 ++++------ .../src/Development/IDE/Plugin/Completions.hs | 9 ++-- .../IDE/Plugin/Completions/Logic.hs | 24 +++------- .../IDE/Plugin/Completions/Types.hs | 24 +++++----- ghcide/src/Development/IDE/Plugin/Test.hs | 2 - .../Development/IDE/Spans/Documentation.hs | 3 -- ghcide/src/Development/IDE/Types/Exports.hs | 11 +---- ghcide/src/Development/IDE/Types/Location.hs | 16 ++++--- ghcide/src/Development/IDE/Types/Options.hs | 2 + 31 files changed, 181 insertions(+), 254 deletions(-) diff --git a/ghcide/session-loader/Development/IDE/Session.hs b/ghcide/session-loader/Development/IDE/Session.hs index 84d55c6787..1f3b67ce58 100644 --- a/ghcide/session-loader/Development/IDE/Session.hs +++ b/ghcide/session-loader/Development/IDE/Session.hs @@ -40,7 +40,6 @@ import Data.Either.Extra import Data.Function import Data.Hashable import qualified Data.HashMap.Strict as HM -import Data.IORef import Data.List import Data.List.Extra (dropPrefix, split) import qualified Data.Map.Strict as Map @@ -111,6 +110,10 @@ import HieDb.Utils import qualified System.Random as Random import System.Random (RandomGen) +#if !MIN_VERSION_ghc(9,4,0) +import Data.IORef +#endif + data Log = LogSettingInitialDynFlags | LogGetInitialGhcLibDirDefaultCradleFail !CradleError !FilePath !(Maybe FilePath) !(Cradle Void) @@ -520,7 +523,7 @@ loadSessionWithOptions recorder SessionLoadingOptions{..} dir = do -- We will modify the unitId and DynFlags used for -- compilation but these are the true source of -- information. - + new_deps = RawComponentInfo (homeUnitId_ df) df targets cfp opts dep_info : maybe [] snd oldDeps -- Get all the unit-ids for things in this component diff --git a/ghcide/src/Development/IDE/Core/Compile.hs b/ghcide/src/Development/IDE/Core/Compile.hs index 8e71948617..882eb63217 100644 --- a/ghcide/src/Development/IDE/Core/Compile.hs +++ b/ghcide/src/Development/IDE/Core/Compile.hs @@ -42,9 +42,8 @@ module Development.IDE.Core.Compile import Control.Monad.IO.Class import Control.Concurrent.Extra import Control.Concurrent.STM.Stats hiding (orElse) -import Control.DeepSeq (NFData (..), force, liftRnf, - rnf, rwhnf) --- 8.10 The import of ‘liftRnf, rwhnf’from module ‘Control.DeepSeq’ is redundant +import Control.DeepSeq (NFData (..), force, + rnf) import Control.Exception (evaluate) import Control.Exception.Safe import Control.Lens hiding (List, (<.>)) @@ -63,14 +62,10 @@ import Data.Generics.Aliases import Data.Generics.Schemes import qualified Data.HashMap.Strict as HashMap import Data.IntMap (IntMap) -import qualified Data.IntMap.Strict as IntMap import Data.IORef import Data.List.Extra -import Data.Map (Map) import qualified Data.Map.Strict as Map import Data.Proxy (Proxy(Proxy)) -import qualified Data.Set as Set --- 8.10 The qualified import of ‘Data.Set’ is redundant except perhaps to import instances from ‘Data.Set’ import Data.Maybe import qualified Data.Text as T import Data.Time (UTCTime (..)) @@ -98,7 +93,6 @@ import Development.IDE.Types.Location import Development.IDE.Types.Options import GHC (ForeignHValue, GetDocsFailure (..), - GhcException (..), parsedSource) import qualified GHC.LanguageExtensions as LangExt import GHC.Serialized @@ -110,7 +104,7 @@ import qualified Language.LSP.Protocol.Message as LSP import System.Directory import System.FilePath import System.IO.Extra (fixIO, newTempFileWithin) -import Unsafe.Coerce + #if !MIN_VERSION_ghc(9,0,1) import HscTypes @@ -125,18 +119,17 @@ import GHC.Tc.Gen.Splice import GHC.Driver.Types #endif +#if !MIN_VERSION_ghc(9,2,0) +import qualified Data.IntMap.Strict as IntMap +import Unsafe.Coerce +#endif + #if MIN_VERSION_ghc(9,2,0) -import GHC (Anchor (anchor), - EpaComment (EpaComment), - EpaCommentTok (EpaBlockComment, EpaLineComment), - ModuleGraph, epAnnComments, - mgLookupModule, - mgModSummaries, - priorComments) import qualified GHC as G -import GHC.Hs (LEpaComment) -import qualified GHC.Types.Error as Error -import Development.IDE.Import.DependencyInformation +#endif + +#if MIN_VERSION_ghc(9,2,0) && !MIN_VERSION_ghc(9,3,0) +import GHC (ModuleGraph) #endif #if MIN_VERSION_ghc(9,2,1) @@ -145,12 +138,21 @@ import GHC.Types.HpcInfo import GHC.Types.TypeEnv #endif +#if !MIN_VERSION_ghc(9,3,0) +import Data.Map (Map) +import GHC (GhcException (..)) +#endif + +#if MIN_VERSION_ghc(9,3,0) +import qualified Data.Set as Set +#endif + #if MIN_VERSION_ghc(9,5,0) -import GHC.Driver.Config.CoreToStg.Prep -import GHC.Core.Lint.Interactive +import GHC.Driver.Config.CoreToStg.Prep +import GHC.Core.Lint.Interactive #endif ---Simple constansts to make sure the source is consistently named +--Simple constants to make sure the source is consistently named sourceTypecheck :: T.Text sourceTypecheck = "typecheck" sourceParser :: T.Text diff --git a/ghcide/src/Development/IDE/Core/FileStore.hs b/ghcide/src/Development/IDE/Core/FileStore.hs index 1f0b9df24c..7238d76519 100644 --- a/ghcide/src/Development/IDE/Core/FileStore.hs +++ b/ghcide/src/Development/IDE/Core/FileStore.hs @@ -28,16 +28,22 @@ import Control.Concurrent.STM.TQueue (writeTQueue) import Control.Exception import Control.Monad.Extra import Control.Monad.IO.Class +import qualified Data.Binary as B import qualified Data.ByteString as BS +import qualified Data.ByteString.Lazy as LBS import qualified Data.HashMap.Strict as HashMap import Data.IORef +import Data.List (foldl') import qualified Data.Text as T +import qualified Data.Text as Text import qualified Data.Text.Utf16.Rope as Rope import Data.Time import Data.Time.Clock.POSIX import Development.IDE.Core.FileUtils +import Development.IDE.Core.IdeConfiguration (isWorkspaceFile) import Development.IDE.Core.RuleTypes import Development.IDE.Core.Shake hiding (Log) +import qualified Development.IDE.Core.Shake as Shake import Development.IDE.GHC.Orphans () import Development.IDE.Graph import Development.IDE.Import.DependencyInformation @@ -45,25 +51,6 @@ import Development.IDE.Types.Diagnostics import Development.IDE.Types.Location import Development.IDE.Types.Options import HieDb.Create (deleteMissingRealFiles) -import Ide.Plugin.Config (CheckParents (..), - Config) -import System.IO.Error - -#ifdef mingw32_HOST_OS -import qualified System.Directory as Dir -#else -#endif - -import qualified Ide.Logger as L - -import Data.Aeson (ToJSON (toJSON)) --- 8.0 The import of ‘Data.Aeson’ is redundant except perhaps to import instances from ‘Data.Aeson’ -import qualified Data.Binary as B -import qualified Data.ByteString.Lazy as LBS -import Data.List (foldl') -import qualified Data.Text as Text -import Development.IDE.Core.IdeConfiguration (isWorkspaceFile) -import qualified Development.IDE.Core.Shake as Shake import Ide.Logger (Pretty (pretty), Priority (Info), Recorder, @@ -71,6 +58,9 @@ import Ide.Logger (Pretty (pretty), cmapWithPrio, logWith, viaShow, (<+>)) +import qualified Ide.Logger as L +import Ide.Plugin.Config (CheckParents (..), + Config) import Language.LSP.Protocol.Message (toUntypedRegistration) import qualified Language.LSP.Protocol.Message as LSP import Language.LSP.Protocol.Types (DidChangeWatchedFilesRegistrationOptions (DidChangeWatchedFilesRegistrationOptions), @@ -80,8 +70,14 @@ import qualified Language.LSP.Protocol.Types as LSP import qualified Language.LSP.Server as LSP import Language.LSP.VFS import System.FilePath +import System.IO.Error import System.IO.Unsafe +#ifdef mingw32_HOST_OS +import qualified System.Directory as Dir +#else +#endif + data Log = LogCouldNotIdentifyReverseDeps !NormalizedFilePath | LogTypeCheckingReverseDeps !NormalizedFilePath !(Maybe [NormalizedFilePath]) diff --git a/ghcide/src/Development/IDE/Core/IdeConfiguration.hs b/ghcide/src/Development/IDE/Core/IdeConfiguration.hs index 7d389fd1da..eb42450bde 100644 --- a/ghcide/src/Development/IDE/Core/IdeConfiguration.hs +++ b/ghcide/src/Development/IDE/Core/IdeConfiguration.hs @@ -12,15 +12,13 @@ module Development.IDE.Core.IdeConfiguration where import Control.Concurrent.Strict -import Control.Lens ((^.)) --- 8.10 The import of ‘Control.Lens’ is redundant except perhaps to import instances from ‘Control.Lens’ + import Control.Monad import Control.Monad.IO.Class import Data.Aeson.Types (Value) import Data.Hashable (Hashed, hashed, unhashed) import Data.HashSet (HashSet, singleton) -import Data.Text (Text, isPrefixOf) --- 8.10 The import of ‘Text’ from module ‘Data.Text’ is redundant +import Data.Text (isPrefixOf) import Development.IDE.Core.Shake import Development.IDE.Graph import Development.IDE.Types.Location diff --git a/ghcide/src/Development/IDE/Core/Preprocessor.hs b/ghcide/src/Development/IDE/Core/Preprocessor.hs index b138e16afd..24bc7beb3e 100644 --- a/ghcide/src/Development/IDE/Core/Preprocessor.hs +++ b/ghcide/src/Development/IDE/Core/Preprocessor.hs @@ -33,7 +33,6 @@ import System.IO.Extra #if MIN_VERSION_ghc(9,3,0) import GHC.Utils.Logger (LogFlags (..)) -import GHC.Utils.Outputable (renderWithContext) #endif -- | Given a file and some contents, apply any necessary preprocessors, diff --git a/ghcide/src/Development/IDE/Core/Rules.hs b/ghcide/src/Development/IDE/Core/Rules.hs index 6ed2a9842c..8a3c9cffe0 100644 --- a/ghcide/src/Development/IDE/Core/Rules.hs +++ b/ghcide/src/Development/IDE/Core/Rules.hs @@ -73,11 +73,7 @@ import Control.Monad.State import Control.Monad.Trans.Except (ExceptT, except, runExceptT) import Control.Monad.Trans.Maybe -import Data.Aeson (Result (Success), - toJSON) --- 8.10 The import of ‘Result, Success’from module ‘Data.Aeson’ is redundant -import qualified Data.Aeson.Types as A --- 8.10 The qualified import of ‘Data.Aeson.Types’ is redundant except perhaps to import instances from ‘Data.Aeson.Types’ +import Data.Aeson (toJSON) import qualified Data.Binary as B import qualified Data.ByteString as BS import qualified Data.ByteString.Lazy as LBS @@ -148,11 +144,8 @@ import Ide.Plugin.Properties (HasProperty, Properties, ToHsType, useProperty) -import Ide.PluginUtils (configForPlugin) --- 8.10 The import of ‘Ide.PluginUtils’ is redundant except perhaps to import instances from ‘Ide.PluginUtils’ import Ide.Types (DynFlagsModifications (dynFlagsModifyGlobal, dynFlagsModifyParser), - PluginId, PluginDescriptor (pluginId), IdePlugins (IdePlugins)) --- 8.10 The import of ‘IdePlugins, IdePlugins, PluginDescriptor, PluginDescriptor(pluginId)’from module ‘Ide.Types’ is redundant + PluginId) import Control.Concurrent.STM.Stats (atomically) import Language.LSP.Server (LspT) import System.Info.Extra (isWindows) @@ -161,22 +154,18 @@ import Ide.Logger (Recorder, logWith, cmapWithPrio, WithPriority, Pretty (pretty import qualified Development.IDE.Core.Shake as Shake import qualified Ide.Logger as Logger import qualified Development.IDE.Types.Shake as Shake -import Development.IDE.GHC.CoreFile --- The import of ‘Development.IDE.GHC.CoreFile’ is redundant except perhaps to import instances from ‘Development.IDE.GHC.CoreFile’ import Data.Time.Clock.POSIX (posixSecondsToUTCTime) import Control.Monad.IO.Unlift -import qualified Data.IntMap as IM --- The qualified import of ‘Data.IntMap’ is redundant except perhaps to import instances from ‘Data.IntMap’ -import GHC (mgModSummaries) + + import GHC.Fingerprint -#if MIN_VERSION_ghc(9,3,0) -import GHC.Unit.Module.Graph -import GHC.Unit.Env +#if !MIN_VERSION_ghc(9,3,0) +import GHC (mgModSummaries) #endif -#if MIN_VERSION_ghc(9,5,0) -import GHC.Unit.Home.ModInfo +#if MIN_VERSION_ghc(9,3,0) +import qualified Data.IntMap as IM #endif diff --git a/ghcide/src/Development/IDE/Core/Shake.hs b/ghcide/src/Development/IDE/Core/Shake.hs index 87e5883497..6fee5a6f0d 100644 --- a/ghcide/src/Development/IDE/Core/Shake.hs +++ b/ghcide/src/Development/IDE/Core/Shake.hs @@ -93,6 +93,7 @@ import Control.Monad.Reader import Control.Monad.Trans.Maybe import Data.Aeson (Result (Success), toJSON) +import qualified Data.Aeson.Types as A import qualified Data.ByteString.Char8 as BS import qualified Data.ByteString.Char8 as BS8 import Data.Coerce (coerce) @@ -100,15 +101,13 @@ import Data.Default import Data.Dynamic import Data.EnumMap.Strict (EnumMap) import qualified Data.EnumMap.Strict as EM -import Data.Foldable (find, for_, toList) --- 8.10 The import of ‘toList’ from module ‘Data.Foldable’ is redundant +import Data.Foldable (find, for_) import Data.Functor ((<&>)) import Data.Functor.Identity import Data.Hashable import qualified Data.HashMap.Strict as HMap import Data.HashSet (HashSet) import qualified Data.HashSet as HSet -import Data.IORef import Data.List.Extra (foldl', partition, takeEnd) import qualified Data.Map.Strict as Map @@ -132,10 +131,7 @@ import Development.IDE.Core.Tracing import Development.IDE.GHC.Compat (NameCache, NameCacheUpdater (..), initNameCache, - knownKeyNames, - mkSplitUniqSupply) - -import qualified Data.Aeson.Types as A + knownKeyNames) import Development.IDE.GHC.Orphans () import Development.IDE.Graph hiding (ShakeValue) import qualified Development.IDE.Graph as Shake @@ -181,7 +177,9 @@ import System.IO.Unsafe (unsafePerformIO) import System.Time.Extra #if !MIN_VERSION_ghc(9,3,0) -import Development.IDE.GHC.Compat (upNameCache) +import Data.IORef +import Development.IDE.GHC.Compat (mkSplitUniqSupply, + upNameCache) #endif data Log diff --git a/ghcide/src/Development/IDE/GHC/CPP.hs b/ghcide/src/Development/IDE/GHC/CPP.hs index 8359621750..930cd7f723 100644 --- a/ghcide/src/Development/IDE/GHC/CPP.hs +++ b/ghcide/src/Development/IDE/GHC/CPP.hs @@ -15,8 +15,6 @@ module Development.IDE.GHC.CPP(doCpp, addOptP) where -import Control.Monad --- 8.10 The import of ‘Control.Monad’ is redundant except perhaps to import instances from ‘Control.Monad’ import Development.IDE.GHC.Compat as Compat import Development.IDE.GHC.Compat.Util import GHC @@ -27,11 +25,14 @@ import ToolSettings #endif #if MIN_VERSION_ghc(9,0,0) -import qualified GHC.Driver.Pipeline as Pipeline import GHC.Settings #endif -#if MIN_VERSION_ghc(9,3,0) +#if MIN_VERSION_ghc(9,0,0) && !MIN_VERSION_ghc(9,3,0) +import qualified GHC.Driver.Pipeline as Pipeline +#endif + +#if MIN_VERSION_ghc(9,3,0) && !MIN_VERSION_ghc(9,5,0) import qualified GHC.Driver.Pipeline.Execute as Pipeline #endif diff --git a/ghcide/src/Development/IDE/GHC/Compat.hs b/ghcide/src/Development/IDE/GHC/Compat.hs index 91c38513ee..af2f3ce69e 100644 --- a/ghcide/src/Development/IDE/GHC/Compat.hs +++ b/ghcide/src/Development/IDE/GHC/Compat.hs @@ -142,7 +142,6 @@ module Development.IDE.GHC.Compat( #endif ) where -import Data.Bifunctor import Development.IDE.GHC.Compat.Core hiding (moduleUnitId) import Development.IDE.GHC.Compat.Env import Development.IDE.GHC.Compat.Iface @@ -164,7 +163,6 @@ import Compat.HieTypes hiding (nodeAnnotations) import qualified Compat.HieTypes as GHC (nodeAnnotations) import Compat.HieUtils import qualified Data.ByteString as BS -import Data.IORef import Data.List (foldl') import qualified Data.Map as Map import qualified Data.Set as S @@ -219,23 +217,16 @@ import GHC.Data.FastString import GHC.Core import GHC.Data.StringBuffer import GHC.Driver.Session hiding (ExposePackage) -import qualified GHC.Types.SrcLoc as SrcLoc import GHC.Types.Var.Env -import GHC.Utils.Error -import GHC.Iface.Env import GHC.Iface.Make (mkIfaceExports) import qualified GHC.SysTools.Tasks as SysTools import qualified GHC.Types.Avail as Avail #endif #if MIN_VERSION_ghc(9,0,0) && !MIN_VERSION_ghc(9,2,0) +import GHC.Utils.Error import GHC.CoreToByteCode (coreExprToBCOs) -import GHC.Driver.Types (Dependencies (dep_mods), - HomePackageTable, - icInteractiveModule, - lookupHpt) import GHC.Runtime.Linker (linkExpr) - import GHC.Driver.Types #endif @@ -243,21 +234,24 @@ import GHC.Driver.Types import GHC.Core.Lint (lintInteractiveExpr) #endif +#if !MIN_VERSION_ghc(9,2,0) +import Data.Bifunctor +#endif + #if MIN_VERSION_ghc(9,2,0) +import GHC.Iface.Env +import qualified GHC.Types.SrcLoc as SrcLoc import GHC.Linker.Loader (loadExpr) -import GHC.Linker.Types (isObjectLinkable) import GHC.Runtime.Context (icInteractiveModule) import GHC.Unit.Home.ModInfo (HomePackageTable, lookupHpt) import GHC.Driver.Env as Env import GHC.Unit.Module.ModIface -import GHC.Unit.Module.ModSummary import GHC.Builtin.Uniques import GHC.ByteCode.Types import GHC.CoreToStg import GHC.Data.Maybe import GHC.Linker.Loader (loadDecls) -import GHC.Runtime.Interpreter import GHC.Stg.Pipeline import GHC.Stg.Syntax import GHC.StgToByteCode @@ -266,14 +260,19 @@ import GHC.Types.IPE #endif #if MIN_VERSION_ghc(9,2,0) && !MIN_VERSION_ghc(9,3,0) -import GHC.Unit.Module.Deps (Dependencies(dep_mods), Usage(..)) +import GHC.Unit.Module.Deps (Dependencies(dep_mods), Usage(..)) +import GHC.Linker.Types (isObjectLinkable) +import GHC.Unit.Module.ModSummary +import GHC.Runtime.Interpreter +#endif + +#if !MIN_VERSION_ghc(9,3,0) +import Data.IORef #endif #if MIN_VERSION_ghc(9,3,0) import GHC.Unit.Module.Deps (Dependencies(dep_direct_mods), Usage(..)) -import GHC.Types.Error import GHC.Driver.Config.Stg.Pipeline -import GHC.Driver.Plugins (PsMessages (..)) #endif #if MIN_VERSION_ghc(9,5,0) diff --git a/ghcide/src/Development/IDE/GHC/Compat/Core.hs b/ghcide/src/Development/IDE/GHC/Compat/Core.hs index ec4d98a442..1e7f9043a8 100644 --- a/ghcide/src/Development/IDE/GHC/Compat/Core.hs +++ b/ghcide/src/Development/IDE/GHC/Compat/Core.hs @@ -500,12 +500,6 @@ module Development.IDE.GHC.Compat.Core ( import qualified GHC -import Data.List (isSuffixOf) --- 8.10 The import of ‘Data.List’ is redundant except perhaps to import instances from ‘Data.List’ -import System.FilePath --- 8.10 The import of ‘System.FilePath’ is redundant except perhaps to import instances from ‘System.FilePath’ -import Data.Foldable (toList) --- 8.10 The import of ‘Data.Foldable’ is redundant except perhaps to import instances from ‘Data.Foldable’ -- NOTE(ozkutuk): Cpp clashes Phase.Cpp, so we hide it. -- Not the greatest solution, but gets the job done -- (until the CPP extension is actually needed). @@ -635,7 +629,6 @@ import GHC.HsToCore.Docs import GHC.HsToCore.Expr import GHC.HsToCore.Monad import GHC.Iface.Load -import GHC.Iface.Make (mkFullIface, mkPartialIface) import GHC.Iface.Make as GHC import GHC.Iface.Recomp import GHC.Iface.Syntax @@ -697,6 +690,7 @@ import qualified GHC.Driver.Finder as GHC #endif #if MIN_VERSION_ghc(9,2,0) +import Data.Foldable (toList) import GHC.Data.Bag import GHC.Core.Multiplicity (scaledThing) import GHC.Driver.Env @@ -709,7 +703,6 @@ import GHC.Hs.ImpExp import GHC.Hs.Pat import GHC.Hs.Type import GHC.Hs.Utils hiding (collectHsBindsBinders) -import qualified GHC.Hs.Utils as GHC import qualified GHC.Linker.Loader as Linker import GHC.Linker.Types import GHC.Parser.Lexer hiding (initParserState, getPsMessages) @@ -727,7 +720,6 @@ import GHC.Types.TyThing import GHC.Types.TyThing.Ppr import GHC.Unit.Finder hiding (mkHomeModLocation) import GHC.Unit.Home.ModInfo -import GHC.Unit.Module.Graph (mkModuleGraph) import GHC.Unit.Module.Imported import GHC.Unit.Module.ModDetails import GHC.Unit.Module.ModGuts @@ -739,16 +731,12 @@ import Language.Haskell.Syntax hiding (FunDep) #if MIN_VERSION_ghc(9,2,0) && !MIN_VERSION_ghc(9,3,0) import GHC.Types.SourceFile (SourceModified(..)) +import GHC.Unit.Module.Graph (mkModuleGraph) import qualified GHC.Unit.Finder as GHC #endif #if MIN_VERSION_ghc(9,3,0) -import GHC.Iface.Recomp (CompileReason(..)) -import GHC.Driver.Env.Types (hsc_type_env_vars) -import GHC.Driver.Env (hscUpdateHUG, hscUpdateHPT, hsc_HUG) import GHC.Driver.Env.KnotVars -import GHC.Iface.Recomp -import GHC.Linker.Types import GHC.Unit.Module.Graph import GHC.Driver.Errors.Types import GHC.Types.Unique.Map @@ -757,7 +745,6 @@ import GHC.Utils.TmpFs import GHC.Utils.Panic import GHC.Unit.Finder.Types import GHC.Unit.Env -import GHC.Driver.Phases import qualified GHC.Driver.Config.Tidy as GHC import qualified GHC.Data.Strict as Strict import GHC.Driver.Env as GHCi diff --git a/ghcide/src/Development/IDE/GHC/Compat/Env.hs b/ghcide/src/Development/IDE/GHC/Compat/Env.hs index d54cb689fb..86df19b6ae 100644 --- a/ghcide/src/Development/IDE/GHC/Compat/Env.hs +++ b/ghcide/src/Development/IDE/GHC/Compat/Env.hs @@ -65,8 +65,7 @@ import Module #if MIN_VERSION_ghc(9,0,0) import GHC.Driver.Hooks (Hooks) import GHC.Driver.Session hiding (mkHomeModule) -import GHC.Unit.Types (Module, Unit, UnitId, - mkModule) +import GHC.Unit.Types (Module, UnitId) #endif #if MIN_VERSION_ghc(9,0,0) && !MIN_VERSION_ghc(9,2,0) @@ -79,6 +78,7 @@ import GHC.Driver.Types (HscEnv, import qualified GHC.Driver.Types as Env import GHC.Driver.Ways hiding (hostFullWays) import qualified GHC.Driver.Ways as Ways +import GHC.Unit.Types (Unit, mkModule) #endif #if MIN_VERSION_ghc(9,0,0) && !MIN_VERSION_ghc(9,5,0) diff --git a/ghcide/src/Development/IDE/GHC/Compat/Logger.hs b/ghcide/src/Development/IDE/GHC/Compat/Logger.hs index 7515f0290e..8e0137f57d 100644 --- a/ghcide/src/Development/IDE/GHC/Compat/Logger.hs +++ b/ghcide/src/Development/IDE/GHC/Compat/Logger.hs @@ -19,10 +19,13 @@ import Outputable (queryQual) #endif #if MIN_VERSION_ghc(9,0,0) -import GHC.Driver.Session as DynFlags import GHC.Utils.Outputable #endif +#if MIN_VERSION_ghc(9,0,0) && !MIN_VERSION_ghc(9,2,0) +import GHC.Driver.Session as DynFlags +#endif + #if MIN_VERSION_ghc(9,2,0) import GHC.Driver.Env (hsc_logger) import GHC.Utils.Logger as Logger diff --git a/ghcide/src/Development/IDE/GHC/Compat/Outputable.hs b/ghcide/src/Development/IDE/GHC/Compat/Outputable.hs index c87b5bb192..6163c5dce4 100644 --- a/ghcide/src/Development/IDE/GHC/Compat/Outputable.hs +++ b/ghcide/src/Development/IDE/GHC/Compat/Outputable.hs @@ -77,7 +77,6 @@ import SrcLoc import GHC.Driver.Env import GHC.Driver.Ppr import GHC.Driver.Session -import qualified GHC.Parser.Errors.Ppr as Ppr import qualified GHC.Types.Error as Error import GHC.Types.Name.Ppr import GHC.Types.Name.Reader @@ -93,13 +92,13 @@ import GHC.Utils.Panic #if MIN_VERSION_ghc(9,2,0) && !MIN_VERSION_ghc(9,3,0) import GHC.Parser.Errors +import qualified GHC.Parser.Errors.Ppr as Ppr #endif #if MIN_VERSION_ghc(9,3,0) import Data.Maybe import GHC.Driver.Config.Diagnostic import GHC.Parser.Errors.Types -import GHC.Utils.Logger #endif #if MIN_VERSION_ghc(9,5,0) diff --git a/ghcide/src/Development/IDE/GHC/Compat/Parser.hs b/ghcide/src/Development/IDE/GHC/Compat/Parser.hs index 093bd02d71..8b52608e4e 100644 --- a/ghcide/src/Development/IDE/GHC/Compat/Parser.hs +++ b/ghcide/src/Development/IDE/GHC/Compat/Parser.hs @@ -71,18 +71,12 @@ import qualified GHC #endif #if MIN_VERSION_ghc(9,2,0) -import GHC (Anchor (anchor), - EpAnnComments (priorComments), - EpaComment (EpaComment), - EpaCommentTok (..), - epAnnComments, +import GHC (EpaCommentTok (..), pm_extra_src_files, pm_mod_summary, pm_parsed_source) import qualified GHC -import GHC.Hs (LEpaComment, hpm_module, - hpm_src_files) -import GHC.Parser.Lexer hiding (initParserState) +import GHC.Hs (hpm_module, hpm_src_files) #endif #if MIN_VERSION_ghc(9,2,0) && !MIN_VERSION_ghc(9,3,0) diff --git a/ghcide/src/Development/IDE/GHC/Compat/Plugins.hs b/ghcide/src/Development/IDE/GHC/Compat/Plugins.hs index 60a2e4f063..faffcb48a8 100644 --- a/ghcide/src/Development/IDE/GHC/Compat/Plugins.hs +++ b/ghcide/src/Development/IDE/GHC/Compat/Plugins.hs @@ -21,10 +21,7 @@ module Development.IDE.GHC.Compat.Plugins ( import Development.IDE.GHC.Compat.Core import Development.IDE.GHC.Compat.Env (hscSetFlags, hsc_dflags) -import Development.IDE.GHC.Compat.Outputable as Out --- 8.10 The import of ‘Development.IDE.GHC.Compat.Outputable’ is redundant except perhaps to import instances from ‘Development.IDE.GHC.Compat.Outputable’ import Development.IDE.GHC.Compat.Parser as Parser -import Development.IDE.GHC.Compat.Util (Bag) #if !MIN_VERSION_ghc(9,0,0) import qualified DynamicLoading as Loader @@ -41,13 +38,21 @@ import qualified GHC.Runtime.Loader as Loader #endif #if MIN_VERSION_ghc(9,0,0) && !MIN_VERSION_ghc(9,3,0) -import Data.Bifunctor (bimap) +import Development.IDE.GHC.Compat.Outputable as Out #endif #if MIN_VERSION_ghc(9,2,0) import qualified GHC.Driver.Env as Env #endif +#if MIN_VERSION_ghc(9,2,0) && !MIN_VERSION_ghc(9,3,0) +import Data.Bifunctor (bimap) +#endif + +#if !MIN_VERSION_ghc(9,3,0) +import Development.IDE.GHC.Compat.Util (Bag) +#endif + #if MIN_VERSION_ghc(9,3,0) import GHC.Driver.Plugins (ParsedResult (..), PsMessages (..), diff --git a/ghcide/src/Development/IDE/GHC/Compat/Units.hs b/ghcide/src/Development/IDE/GHC/Compat/Units.hs index 58b21168ca..a39f225e4f 100644 --- a/ghcide/src/Development/IDE/GHC/Compat/Units.hs +++ b/ghcide/src/Development/IDE/GHC/Compat/Units.hs @@ -53,19 +53,11 @@ module Development.IDE.GHC.Compat.Units ( findImportedModule, ) where -import Control.Monad --- 8.10 The import of ‘Control.Monad’ is redundant except perhaps to import instances from ‘Control.Monad’ -import qualified Data.List.NonEmpty as NE --- 8.10 The qualified import of ‘Data.List.NonEmpty’ is redundant except perhaps to import instances from ‘Data.List.NonEmpty’ -import qualified Data.Map.Strict as Map --- 8.10 The qualified import of ‘Data.Map.Strict’ is redundant except perhaps to import instances from ‘Data.Map.Strict’ import Data.Either import Data.Version import Development.IDE.GHC.Compat.Core import Development.IDE.GHC.Compat.Env import Development.IDE.GHC.Compat.Outputable -import qualified GHC --- 8.10 The qualified import of ‘GHC’ is redundant except perhaps to import instances from ‘GHC’ #if !MIN_VERSION_ghc(9,0,0) import qualified DynFlags @@ -85,8 +77,6 @@ import qualified Packages #endif #if MIN_VERSION_ghc(9,0,0) -import GHC.Data.FastString -import qualified GHC.Driver.Session as DynFlags import GHC.Types.Unique.Set import qualified GHC.Unit.Info as UnitInfo import GHC.Unit.State (LookupResult, UnitInfo, @@ -95,30 +85,38 @@ import qualified GHC.Unit.State as State import GHC.Unit.Types hiding (moduleUnit, toUnitId) import qualified GHC.Unit.Types as Unit -import GHC.Utils.Outputable #endif #if MIN_VERSION_ghc(9,0,0) && !MIN_VERSION_ghc(9,2,0) import Data.Map (Map) import qualified GHC.Driver.Finder as GHC +import qualified GHC.Driver.Session as DynFlags import GHC.Driver.Types #endif +#if MIN_VERSION_ghc(9,0,0) && !MIN_VERSION_ghc(9,3,0) +import GHC.Data.FastString + +#endif + #if MIN_VERSION_ghc(9,2,0) import qualified GHC.Data.ShortText as ST -import GHC.Driver.Ppr -import GHC.Unit.Env import GHC.Unit.External -import GHC.Unit.Finder hiding - (findImportedModule) import qualified GHC.Unit.Finder as GHC #endif #if MIN_VERSION_ghc(9,2,0) && !MIN_VERSION_ghc(9,3,0) -import GHC.Driver.Env (hsc_unit_dbs) +import GHC.Unit.Env +import GHC.Unit.Finder hiding + (findImportedModule) #endif #if MIN_VERSION_ghc(9,3,0) +import Control.Monad +import qualified Data.List.NonEmpty as NE +import qualified Data.Map.Strict as Map +import qualified GHC +import qualified GHC.Driver.Session as DynFlags import GHC.Types.PkgQual (PkgQual (NoPkgQual)) import GHC.Unit.Home.ModInfo #endif diff --git a/ghcide/src/Development/IDE/GHC/Compat/Util.hs b/ghcide/src/Development/IDE/GHC/Compat/Util.hs index 2b4344a90c..6728a1e7e5 100644 --- a/ghcide/src/Development/IDE/GHC/Compat/Util.hs +++ b/ghcide/src/Development/IDE/GHC/Compat/Util.hs @@ -99,11 +99,14 @@ import GHC.Data.StringBuffer import GHC.Types.Unique import GHC.Types.Unique.DFM import GHC.Utils.Fingerprint -import GHC.Utils.Misc import GHC.Utils.Outputable (pprHsString) import GHC.Utils.Panic hiding (try) #endif +#if MIN_VERSION_ghc(9,0,0) && !MIN_VERSION_ghc(9,3,0) +import GHC.Utils.Misc +#endif + #if MIN_VERSION_ghc(9,3,0) import GHC.Data.Bool #endif diff --git a/ghcide/src/Development/IDE/GHC/Orphans.hs b/ghcide/src/Development/IDE/GHC/Orphans.hs index 0791b823ec..5e7832f58e 100644 --- a/ghcide/src/Development/IDE/GHC/Orphans.hs +++ b/ghcide/src/Development/IDE/GHC/Orphans.hs @@ -13,8 +13,6 @@ import Development.IDE.GHC.Util import Control.DeepSeq import Data.Aeson -import Data.Bifunctor (Bifunctor (..)) --- 8.10 The import of ‘Data.Bifunctor’ is redundant except perhaps to import instances from ‘Data.Bifunctor’ import Data.Hashable import Data.String (IsString (fromString)) import Data.Text (unpack) @@ -28,19 +26,21 @@ import Unique (getKey) #endif #if MIN_VERSION_ghc(9,0,0) -import GHC (ModuleGraph) import GHC.ByteCode.Types import GHC.Data.Bag import GHC.Data.FastString import qualified GHC.Data.StringBuffer as SB -import GHC.Types.Name.Occurrence import GHC.Types.SrcLoc + +#endif + +#if MIN_VERSION_ghc(9,0,0) && !MIN_VERSION_ghc(9,3,0) +import GHC (ModuleGraph) import GHC.Types.Unique (getKey) -import GHC.Unit.Info -import GHC.Utils.Outputable #endif #if MIN_VERSION_ghc(9,2,0) +import Data.Bifunctor (Bifunctor (..)) import GHC.Parser.Annotation #endif diff --git a/ghcide/src/Development/IDE/GHC/Util.hs b/ghcide/src/Development/IDE/GHC/Util.hs index 7f666d1f03..3a5be4582a 100644 --- a/ghcide/src/Development/IDE/GHC/Util.hs +++ b/ghcide/src/Development/IDE/GHC/Util.hs @@ -37,22 +37,13 @@ import qualified Data.ByteString as BS import Data.ByteString.Internal (ByteString (..)) import qualified Data.ByteString.Internal as BS import qualified Data.ByteString.Lazy as LBS -import Data.Data (Data) --- 8.10 The import of ‘Data.Data’ is redundant except perhaps to import instances from ‘Data.Data’ import Data.IORef import Data.List.Extra import Data.Maybe import qualified Data.Text as T import qualified Data.Text.Encoding as T import qualified Data.Text.Encoding.Error as T -import Data.Time.Clock.POSIX (POSIXTime, getCurrentTime, - utcTimeToPOSIXSeconds) --- 8.10 The import of ‘Data.Time.Clock.POSIX’ is redundant except perhaps to import instances from ‘Data.Time.Clock.POSIX’ import Data.Typeable -import qualified Data.Unique as U --- 8.10 The qualified import of ‘Data.Unique’ is redundant except perhaps to import instances from ‘Data.Unique’ -import Debug.Trace --- 8.10 The import of ‘Debug.Trace’ is redundant except perhaps to import instances from ‘Debug.Trace’ import Development.IDE.GHC.Compat as GHC import qualified Development.IDE.GHC.Compat.Parser as Compat import qualified Development.IDE.GHC.Compat.Units as Compat @@ -67,16 +58,8 @@ import GHC.IO.Encoding import GHC.IO.Exception import GHC.IO.Handle.Internals import GHC.IO.Handle.Types -import GHC.Stack --- 8.10 The import of ‘GHC.Stack’ is redundant except perhaps to import instances from ‘GHC.Stack’ import Ide.PluginUtils (unescape) -import System.Environment.Blank (getEnvDefault) --- 8.10 The import of ‘System.Environment.Blank’ is redundant except perhaps to import instances from ‘System.Environment.Blank’ import System.FilePath -import System.IO.Unsafe --- 8.10 The import of ‘System.IO.Unsafe’ is redundant except perhaps to import instances from ‘System.IO.Unsafe’ -import Text.Printf --- 8.10 The import of ‘Text.Printf’ is redundant except perhaps to import instances from ‘Text.Printf’ #if !MIN_VERSION_ghc(9,2,0) import Development.IDE.GHC.Compat.Util @@ -86,18 +69,7 @@ import Development.IDE.GHC.Compat.Util import GHC.Data.EnumSet import GHC.Data.FastString import GHC.Data.StringBuffer -import GHC.Driver.Env hiding (hscSetFlags) -import GHC.Driver.Monad -import GHC.Driver.Session hiding (ExposePackage) -import GHC.Parser.Lexer -import GHC.Runtime.Context -import GHC.Types.Name.Occurrence -import GHC.Types.Name.Reader -import GHC.Types.SrcLoc -import GHC.Unit.Module.ModDetails -import GHC.Unit.Module.ModGuts import GHC.Utils.Fingerprint -import GHC.Utils.Outputable #endif ---------------------------------------------------------------------- -- GHC setup diff --git a/ghcide/src/Development/IDE/Import/FindImports.hs b/ghcide/src/Development/IDE/Import/FindImports.hs index 3fcf175c41..490dde5c78 100644 --- a/ghcide/src/Development/IDE/Import/FindImports.hs +++ b/ghcide/src/Development/IDE/Import/FindImports.hs @@ -15,7 +15,6 @@ module Development.IDE.Import.FindImports import Control.DeepSeq import Development.IDE.GHC.Compat as Compat -import Development.IDE.GHC.Compat.Util import Development.IDE.GHC.Error as ErrUtils import Development.IDE.GHC.Orphans () import Development.IDE.Types.Diagnostics @@ -28,6 +27,10 @@ import Data.List (isSuffixOf) import Data.Maybe import System.FilePath +#if !MIN_VERSION_ghc(9,3,0) +import Development.IDE.GHC.Compat.Util +#endif + #if MIN_VERSION_ghc(9,3,0) import GHC.Types.PkgQual import GHC.Unit.State diff --git a/ghcide/src/Development/IDE/LSP/HoverDefinition.hs b/ghcide/src/Development/IDE/LSP/HoverDefinition.hs index 3a10b7c26e..d01e631aa0 100644 --- a/ghcide/src/Development/IDE/LSP/HoverDefinition.hs +++ b/ghcide/src/Development/IDE/LSP/HoverDefinition.hs @@ -31,9 +31,9 @@ import qualified Language.LSP.Server as LSP import qualified Data.Text as T -gotoDefinition :: IdeState -> TextDocumentPositionParams -> ExceptT PluginError (LSP.LspM c) (MessageResult Method_TextDocumentDefinition) +gotoDefinition :: IdeState -> TextDocumentPositionParams -> ExceptT PluginError (LSP.LspM c) (MessageResult 'Method_TextDocumentDefinition) hover :: IdeState -> TextDocumentPositionParams -> ExceptT PluginError (LSP.LspM c) (Hover |? Null) -gotoTypeDefinition :: IdeState -> TextDocumentPositionParams -> ExceptT PluginError (LSP.LspM c) (MessageResult Method_TextDocumentTypeDefinition) +gotoTypeDefinition :: IdeState -> TextDocumentPositionParams -> ExceptT PluginError (LSP.LspM c) (MessageResult 'Method_TextDocumentTypeDefinition) documentHighlight :: IdeState -> TextDocumentPositionParams -> ExceptT PluginError (LSP.LspM c) ([DocumentHighlight] |? Null) gotoDefinition = request "Definition" getDefinition (InR $ InR Null) (InL . Definition. InR) gotoTypeDefinition = request "TypeDefinition" getTypeDefinition (InR $ InR Null) (InL . Definition. InR) diff --git a/ghcide/src/Development/IDE/LSP/Outline.hs b/ghcide/src/Development/IDE/LSP/Outline.hs index 20a039d8ff..e72296a5bb 100644 --- a/ghcide/src/Development/IDE/LSP/Outline.hs +++ b/ghcide/src/Development/IDE/LSP/Outline.hs @@ -11,11 +11,8 @@ where import Control.Monad.IO.Class import Data.Functor -import Data.Foldable (toList) ---8.10 The import of ‘Data.Foldable’ is redundant except perhaps to import instances from ‘Data.Foldable’ import Data.Generics hiding (Prefix) import Data.Maybe -import qualified Data.Text as T import Development.IDE.Core.Rules import Development.IDE.Core.Shake import Development.IDE.GHC.Compat @@ -32,7 +29,12 @@ import Language.LSP.Protocol.Types (DocumentSymbol (..), import Language.LSP.Protocol.Message #if MIN_VERSION_ghc(9,2,0) -import Data.List.NonEmpty (nonEmpty) +import Data.List.NonEmpty (nonEmpty) +import Data.Foldable (toList) +#endif + +#if !MIN_VERSION_ghc(9,3,0) +import qualified Data.Text as T #endif moduleOutline diff --git a/ghcide/src/Development/IDE/Main.hs b/ghcide/src/Development/IDE/Main.hs index 92acfcbafc..2036193acb 100644 --- a/ghcide/src/Development/IDE/Main.hs +++ b/ghcide/src/Development/IDE/Main.hs @@ -11,6 +11,7 @@ module Development.IDE.Main ,testing ,Log(..) ) where + import Control.Concurrent.Extra (withNumCapabilities) import Control.Concurrent.STM.Stats (dumpSTMStats) import Control.Exception.Safe (SomeException, @@ -29,11 +30,8 @@ import Data.List.Extra (intercalate, import Data.Maybe (catMaybes, isJust) import qualified Data.Text as T import Development.IDE (Action, - GhcVersion (..), Priority (Debug, Error), - Rules, ghcVersion, - hDuplicateTo') --- 8.10 The import of ‘GhcVersion, ghcVersion’from module ‘Development.IDE’ is redundant + Rules, hDuplicateTo') import Development.IDE.Core.Debouncer (Debouncer, newAsyncDebouncer) import Development.IDE.Core.FileStore (isWatchSupported) @@ -77,15 +75,6 @@ import Development.IDE.Session (SessionLoadingOptions import qualified Development.IDE.Session as Session import Development.IDE.Types.Location (NormalizedUri, toNormalizedFilePath') -import Ide.Logger (Logger, - Pretty (pretty), - Priority (Info, Warning), - Recorder, - WithPriority, - cmapWithPrio, - logWith, nest, vsep, - (<+>)) --- 8.10 The import of ‘Warning’ from module ‘Ide.Logger’ is redundant import Development.IDE.Types.Monitoring (Monitoring) import Development.IDE.Types.Options (IdeGhcSession, IdeOptions (optCheckParents, optCheckProject, optReportProgress, optRunSubset), @@ -100,6 +89,14 @@ import GHC.IO.Encoding (setLocaleEncoding) import GHC.IO.Handle (hDuplicate) import HIE.Bios.Cradle (findCradle) import qualified HieDb.Run as HieDb +import Ide.Logger (Logger, + Pretty (pretty), + Priority (Info), + Recorder, + WithPriority, + cmapWithPrio, + logWith, nest, vsep, + (<+>)) import Ide.Plugin.Config (CheckParents (NeverCheck), Config, checkParents, checkProject, diff --git a/ghcide/src/Development/IDE/Plugin/Completions.hs b/ghcide/src/Development/IDE/Plugin/Completions.hs index 757f94d46b..406b86bb65 100644 --- a/ghcide/src/Development/IDE/Plugin/Completions.hs +++ b/ghcide/src/Development/IDE/Plugin/Completions.hs @@ -15,8 +15,6 @@ import Control.Lens ((&), (.~), (?~)) import Control.Monad.IO.Class import Control.Monad.Trans.Except (ExceptT (ExceptT), withExceptT) -import Data.Aeson --- 8.10 The import of ‘Data.Aeson’ is redundant except perhaps to import instances from ‘Data.Aeson’ import qualified Data.HashMap.Strict as Map import qualified Data.HashSet as Set import Data.Maybe @@ -54,10 +52,13 @@ import Numeric.Natural import Text.Fuzzy.Parallel (Scored (..)) import Development.IDE.Core.Rules (usePropertyAction) -import qualified GHC.LanguageExtensions as LangExt --- 8.10 The qualified import of ‘GHC.LanguageExtensions’ is redundant except perhaps to import instances from ‘GHC.LanguageExtensions’ + import qualified Ide.Plugin.Config as Config +#if MIN_VERSION_ghc(9,2,0) +import qualified GHC.LanguageExtensions as LangExt +#endif + data Log = LogShake Shake.Log deriving Show instance Pretty Log where diff --git a/ghcide/src/Development/IDE/Plugin/Completions/Logic.hs b/ghcide/src/Development/IDE/Plugin/Completions/Logic.hs index ad778941ce..d8409b502c 100644 --- a/ghcide/src/Development/IDE/Plugin/Completions/Logic.hs +++ b/ghcide/src/Development/IDE/Plugin/Completions/Logic.hs @@ -24,28 +24,21 @@ import Data.List.Extra as List hiding import qualified Data.Map as Map import Data.Row -import Data.Maybe (catMaybes, fromMaybe, - isJust, isNothing, +import Data.Maybe (fromMaybe, isJust, + isNothing, listToMaybe, mapMaybe) --- 8.10 The import of ‘catMaybes’ from module ‘Data.Maybe’ is redundant import qualified Data.Text as T import qualified Text.Fuzzy.Parallel as Fuzzy import Control.Monad import Data.Aeson (ToJSON (toJSON)) import Data.Function (on) -import Data.Functor --- 8.10 The import of ‘Data.Functor’ is redundant except perhaps to import instances from ‘Data.Functor’ -import qualified Data.HashMap.Strict as HM --- 8.10 The qualified import of ‘Data.HashMap.Strict’ is redundant except perhaps to import instances from ‘Data.HashMap.Strict’ import qualified Data.HashSet as HashSet import Data.Monoid (First (..)) import Data.Ord (Down (Down)) import qualified Data.Set as Set -import Development.IDE.Core.Compile --- 8.10 The import of ‘Development.IDE.Core.Compile’ is redundant except perhaps to import instances from ‘Development.IDE.Core.Compile’ import Development.IDE.Core.PositionMapping import Development.IDE.GHC.Compat hiding (ppr) import qualified Development.IDE.GHC.Compat as GHC @@ -54,14 +47,8 @@ import Development.IDE.GHC.CoreFile (occNamePrefixes) import Development.IDE.GHC.Error import Development.IDE.GHC.Util import Development.IDE.Plugin.Completions.Types -import Development.IDE.Spans.Common --- 8.10 The import of ‘Development.IDE.Spans.Common’ is redundant except perhaps to import instances from ‘Development.IDE.Spans.Common’ -import Development.IDE.Spans.Documentation --- 8.10 The import of ‘Development.IDE.Spans.Documentation’ is redundant except perhaps to import instances from ‘Development.IDE.Spans.Documentation’ import Development.IDE.Spans.LocalBindings import Development.IDE.Types.Exports -import Development.IDE.Types.HscEnvEq --- 8.10 The import of ‘Development.IDE.Types.HscEnvEq’ is redundant except perhaps to import instances from ‘Development.IDE.Types.HscEnvEq’ import Development.IDE.Types.Options import Ide.PluginUtils (mkLspCommand) import Ide.Types (CommandId (..), @@ -80,13 +67,16 @@ import Development.IDE.Spans.AtPoint (pointCommand) #if MIN_VERSION_ghc(9,2,0) import GHC.Plugins (Depth (AllTheWay), - defaultSDocContext, mkUserStyle, neverQualify, - renderWithContext, sdocStyle) #endif +#if MIN_VERSION_ghc(9,2,0) && !MIN_VERSION_ghc(9,3,0) +import GHC.Plugins (defaultSDocContext, + renderWithContext) +#endif + #if MIN_VERSION_ghc(9,5,0) import Language.Haskell.Syntax.Basic #endif diff --git a/ghcide/src/Development/IDE/Plugin/Completions/Types.hs b/ghcide/src/Development/IDE/Plugin/Completions/Types.hs index 93f908d2b4..0f748f25e0 100644 --- a/ghcide/src/Development/IDE/Plugin/Completions/Types.hs +++ b/ghcide/src/Development/IDE/Plugin/Completions/Types.hs @@ -9,29 +9,27 @@ module Development.IDE.Plugin.Completions.Types ( ) where import Control.DeepSeq -import qualified Data.Map as Map -import qualified Data.Text as T +import qualified Data.Map as Map +import qualified Data.Text as T import Data.Aeson import Data.Aeson.Types -import Data.Hashable (Hashable) -import Data.Text (Text) -import Data.Typeable (Typeable) +import Data.Hashable (Hashable) +import Data.Text (Text) +import Data.Typeable (Typeable) import Development.IDE.GHC.Compat -import Development.IDE.Graph (RuleResult) -import Development.IDE.Spans.Common --- 8.10 The import of ‘Development.IDE.Spans.Common’ is redundant except perhaps to import instances from ‘Development.IDE.Spans.Common’ -import GHC.Generics (Generic) +import Development.IDE.Graph (RuleResult) +import GHC.Generics (Generic) import Ide.Plugin.Properties -import Language.LSP.Protocol.Types (CompletionItemKind (..), Uri) -import qualified Language.LSP.Protocol.Types as J +import Language.LSP.Protocol.Types (CompletionItemKind (..), Uri) +import qualified Language.LSP.Protocol.Types as J #if !MIN_VERSION_ghc(9,0,0) -import qualified OccName as Occ +import qualified OccName as Occ #endif #if MIN_VERSION_ghc(9,0,0) -import qualified GHC.Types.Name.Occurrence as Occ +import qualified GHC.Types.Name.Occurrence as Occ #endif diff --git a/ghcide/src/Development/IDE/Plugin/Test.hs b/ghcide/src/Development/IDE/Plugin/Test.hs index 84c5c124e1..72a1d5b912 100644 --- a/ghcide/src/Development/IDE/Plugin/Test.hs +++ b/ghcide/src/Development/IDE/Plugin/Test.hs @@ -46,8 +46,6 @@ import Development.IDE.Types.Action import Development.IDE.Types.HscEnvEq (HscEnvEq (hscEnv)) import Development.IDE.Types.Location (fromUri) import GHC.Generics (Generic) -import Ide.Plugin.Config (CheckParents) --- 8.10 The import of ‘Ide.Plugin.Config’ is redundant except perhaps to import instances from ‘Ide.Plugin.Config’ import Ide.Plugin.Error import Ide.Types import Language.LSP.Protocol.Message diff --git a/ghcide/src/Development/IDE/Spans/Documentation.hs b/ghcide/src/Development/IDE/Spans/Documentation.hs index a66457d6f8..9ae4e7ce01 100644 --- a/ghcide/src/Development/IDE/Spans/Documentation.hs +++ b/ghcide/src/Development/IDE/Spans/Documentation.hs @@ -33,9 +33,6 @@ import Language.LSP.Protocol.Types (filePathToUri, getUri) import System.Directory import System.FilePath -#if MIN_VERSION_ghc(9,3,0) -import GHC.Types.Unique.Map -#endif mkDocMap :: HscEnv diff --git a/ghcide/src/Development/IDE/Types/Exports.hs b/ghcide/src/Development/IDE/Types/Exports.hs index 35f88a7a69..3a507eb3c0 100644 --- a/ghcide/src/Development/IDE/Types/Exports.hs +++ b/ghcide/src/Development/IDE/Types/Exports.hs @@ -23,24 +23,15 @@ module Development.IDE.Types.Exports import Control.DeepSeq (NFData (..), force, ($!!)) import Control.Monad -import Data.Bifunctor (Bifunctor (second)) --- 8.10 The import of ‘Data.Bifunctor’ is redundant except perhaps to import instances from ‘Data.Bifunctor’ import Data.Char (isUpper) import Data.Hashable (Hashable) -import Data.HashMap.Strict (HashMap, elems) --- 8.10 The import of ‘Data.HashMap.Strict’ is redundant except perhaps to import instances from ‘Data.HashMap.Strict’ -import qualified Data.HashMap.Strict as Map --- 8.10 The qualified import of ‘Data.HashMap.Strict’ is redundant except perhaps to import instances from ‘Data.HashMap.Strict’ import Data.HashSet (HashSet) import qualified Data.HashSet as Set -import Data.List (foldl', isSuffixOf) --- 8.10 The import of ‘foldl'’ from module ‘Data.List’ is redundant +import Data.List (isSuffixOf) import Data.Text (Text, uncons) import Data.Text.Encoding (decodeUtf8, encodeUtf8) import Development.IDE.GHC.Compat import Development.IDE.GHC.Orphans () -import Development.IDE.GHC.Util --- 8.10 The import of ‘Development.IDE.GHC.Util’ is redundant except perhaps to import instances from ‘Development.IDE.GHC.Util’ import GHC.Generics (Generic) import HieDb diff --git a/ghcide/src/Development/IDE/Types/Location.hs b/ghcide/src/Development/IDE/Types/Location.hs index 6878c6f0f8..6b822a02bf 100644 --- a/ghcide/src/Development/IDE/Types/Location.hs +++ b/ghcide/src/Development/IDE/Types/Location.hs @@ -31,18 +31,20 @@ import Control.Monad import Data.Hashable (Hashable (hash)) import Data.Maybe (fromMaybe) import Data.String +import Language.LSP.Protocol.Types (Location (..), Position (..), + Range (..)) +import qualified Language.LSP.Protocol.Types as LSP +import Text.ParserCombinators.ReadP as ReadP + +#if !MIN_VERSION_ghc(9,0,0) +import FastString +import SrcLoc as GHC +#endif #if MIN_VERSION_ghc(9,0,0) import GHC.Data.FastString import GHC.Types.SrcLoc as GHC -#else -import FastString -import SrcLoc as GHC #endif -import Language.LSP.Protocol.Types (Location (..), Position (..), - Range (..)) -import qualified Language.LSP.Protocol.Types as LSP -import Text.ParserCombinators.ReadP as ReadP toNormalizedFilePath' :: FilePath -> LSP.NormalizedFilePath -- We want to keep empty paths instead of normalising them to "." diff --git a/ghcide/src/Development/IDE/Types/Options.hs b/ghcide/src/Development/IDE/Types/Options.hs index 9d4b18ad52..1291e044f4 100644 --- a/ghcide/src/Development/IDE/Types/Options.hs +++ b/ghcide/src/Development/IDE/Types/Options.hs @@ -18,6 +18,7 @@ module Development.IDE.Types.Options , OptHaddockParse(..) , ProgressReportingStyle(..) ) where + import Control.Lens import qualified Data.Text as T import Data.Typeable @@ -29,6 +30,7 @@ import Ide.Plugin.Config import Ide.Types (DynFlagsModifications) import qualified Language.LSP.Protocol.Lens as L import qualified Language.LSP.Protocol.Types as LSP + data IdeOptions = IdeOptions { optPreprocessor :: GHC.ParsedSource -> IdePreprocessedSource -- ^ Preprocessor to run over all parsed source trees, generating a list of warnings From 0a5089543415954ff4ff36f4a30d00c034077238 Mon Sep 17 00:00:00 2001 From: Nathan Maxson Date: Mon, 14 Aug 2023 18:55:33 +0300 Subject: [PATCH 05/18] fix instance error --- .../IDE/Plugin/Completions/Types.hs | 23 ++++++++++--------- 1 file changed, 12 insertions(+), 11 deletions(-) diff --git a/ghcide/src/Development/IDE/Plugin/Completions/Types.hs b/ghcide/src/Development/IDE/Plugin/Completions/Types.hs index 0f748f25e0..0d19d74905 100644 --- a/ghcide/src/Development/IDE/Plugin/Completions/Types.hs +++ b/ghcide/src/Development/IDE/Plugin/Completions/Types.hs @@ -9,27 +9,28 @@ module Development.IDE.Plugin.Completions.Types ( ) where import Control.DeepSeq -import qualified Data.Map as Map -import qualified Data.Text as T +import qualified Data.Map as Map +import qualified Data.Text as T import Data.Aeson import Data.Aeson.Types -import Data.Hashable (Hashable) -import Data.Text (Text) -import Data.Typeable (Typeable) +import Data.Hashable (Hashable) +import Data.Text (Text) +import Data.Typeable (Typeable) import Development.IDE.GHC.Compat -import Development.IDE.Graph (RuleResult) -import GHC.Generics (Generic) +import Development.IDE.Graph (RuleResult) +import Development.IDE.Spans.Common () +import GHC.Generics (Generic) import Ide.Plugin.Properties -import Language.LSP.Protocol.Types (CompletionItemKind (..), Uri) -import qualified Language.LSP.Protocol.Types as J +import Language.LSP.Protocol.Types (CompletionItemKind (..), Uri) +import qualified Language.LSP.Protocol.Types as J #if !MIN_VERSION_ghc(9,0,0) -import qualified OccName as Occ +import qualified OccName as Occ #endif #if MIN_VERSION_ghc(9,0,0) -import qualified GHC.Types.Name.Occurrence as Occ +import qualified GHC.Types.Name.Occurrence as Occ #endif From 889326e9a218e5a3c7d80010494ac218e79b4a9f Mon Sep 17 00:00:00 2001 From: Nathan Maxson Date: Mon, 14 Aug 2023 22:44:48 +0300 Subject: [PATCH 06/18] fix 9.2 build --- ghcide/src/Development/IDE/Core/Compile.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/ghcide/src/Development/IDE/Core/Compile.hs b/ghcide/src/Development/IDE/Core/Compile.hs index 882eb63217..7b10289099 100644 --- a/ghcide/src/Development/IDE/Core/Compile.hs +++ b/ghcide/src/Development/IDE/Core/Compile.hs @@ -121,7 +121,6 @@ import GHC.Driver.Types #if !MIN_VERSION_ghc(9,2,0) import qualified Data.IntMap.Strict as IntMap -import Unsafe.Coerce #endif #if MIN_VERSION_ghc(9,2,0) @@ -141,6 +140,7 @@ import GHC.Types.TypeEnv #if !MIN_VERSION_ghc(9,3,0) import Data.Map (Map) import GHC (GhcException (..)) +import Unsafe.Coerce #endif #if MIN_VERSION_ghc(9,3,0) From d067793ebb3e6efbc688d4665ed7f1bf98d94c52 Mon Sep 17 00:00:00 2001 From: Nathan Maxson Date: Tue, 15 Aug 2023 19:12:49 +0300 Subject: [PATCH 07/18] fix name-shadowing --- ghcide/ghcide.cabal | 20 ++++ .../session-loader/Development/IDE/Session.hs | 86 ++++++++--------- ghcide/src/Development/IDE/Core/Compile.hs | 63 ++++++------- ghcide/src/Development/IDE/Core/FileExists.hs | 4 +- ghcide/src/Development/IDE/Core/FileStore.hs | 7 +- ghcide/src/Development/IDE/Core/OfInterest.hs | 2 +- .../Development/IDE/Core/PositionMapping.hs | 6 +- .../src/Development/IDE/Core/Preprocessor.hs | 60 ++++++------ .../Development/IDE/Core/ProgressReporting.hs | 18 ++-- ghcide/src/Development/IDE/Core/Rules.hs | 81 ++++++++-------- ghcide/src/Development/IDE/Core/Service.hs | 6 +- ghcide/src/Development/IDE/Core/Shake.hs | 92 +++++++++---------- ghcide/src/Development/IDE/GHC/CPP.hs | 2 +- ghcide/src/Development/IDE/GHC/Compat.hs | 16 ++-- ghcide/src/Development/IDE/GHC/Compat/Env.hs | 2 +- .../src/Development/IDE/GHC/Compat/Units.hs | 1 + ghcide/src/Development/IDE/GHC/CoreFile.hs | 17 ++-- ghcide/src/Development/IDE/GHC/Error.hs | 8 +- ghcide/src/Development/IDE/GHC/Util.hs | 11 ++- .../IDE/Import/DependencyInformation.hs | 27 +++--- .../src/Development/IDE/Import/FindImports.hs | 22 ++--- .../src/Development/IDE/LSP/LanguageServer.hs | 23 ++--- .../src/Development/IDE/LSP/Notifications.hs | 4 +- ghcide/src/Development/IDE/LSP/Outline.hs | 18 ++-- ghcide/src/Development/IDE/Main.hs | 67 +++++++------- ghcide/src/Development/IDE/Main/HeapStats.hs | 2 +- .../IDE/Monitoring/OpenTelemetry.hs | 4 +- .../src/Development/IDE/Plugin/Completions.hs | 18 ++-- .../IDE/Plugin/Completions/Logic.hs | 40 ++++---- ghcide/src/Development/IDE/Plugin/HLS.hs | 22 ++--- .../src/Development/IDE/Plugin/HLS/GhcIde.hs | 6 +- .../src/Development/IDE/Plugin/TypeLenses.hs | 8 +- ghcide/src/Development/IDE/Spans/AtPoint.hs | 42 +++++---- .../Development/IDE/Spans/Documentation.hs | 19 ++-- ghcide/src/Development/IDE/Spans/Pragmas.hs | 12 +-- ghcide/src/Development/IDE/Types/Exports.hs | 11 ++- ghcide/src/Development/IDE/Types/HscEnvEq.hs | 2 +- ghcide/src/Generics/SYB/GHC.hs | 2 +- 38 files changed, 432 insertions(+), 419 deletions(-) diff --git a/ghcide/ghcide.cabal b/ghcide/ghcide.cabal index e649c0333b..7a111928a0 100644 --- a/ghcide/ghcide.cabal +++ b/ghcide/ghcide.cabal @@ -35,6 +35,11 @@ flag ekg default: False manual: True +flag pedantic + description: Enable -Werror + default: False + manual: True + library default-language: Haskell2010 build-depends: @@ -227,6 +232,21 @@ library if flag(ghc-patched-unboxed-bytecode) cpp-options: -DGHC_PATCHED_UNBOXED_BYTECODE + if flag(pedantic) + ghc-options: -Werror + -Wwarn=unused-packages + -Wwarn=dodgy-imports + -Wwarn=missing-signatures + -Wwarn=duplicate-exports + -Wwarn=dodgy-exports + -Wwarn=unused-top-binds + -Wwarn=incomplete-patterns + -Wwarn=unused-local-binds + -Wwarn=orphans + -Wwarn=unused-matches + -Wwarn=ambiguous-fields + -Wwarn=overlapping-patterns + if impl(ghc >= 9) ghc-options: -Wunused-packages diff --git a/ghcide/session-loader/Development/IDE/Session.hs b/ghcide/session-loader/Development/IDE/Session.hs index 1f3b67ce58..30d20c5234 100644 --- a/ghcide/session-loader/Development/IDE/Session.hs +++ b/ghcide/session-loader/Development/IDE/Session.hs @@ -38,7 +38,7 @@ import Data.Char (isLower) import Data.Default import Data.Either.Extra import Data.Function -import Data.Hashable +import Data.Hashable hiding (hash) import qualified Data.HashMap.Strict as HM import Data.List import Data.List.Extra (dropPrefix, split) @@ -50,11 +50,11 @@ import Data.Time.Clock import Data.Version import Development.IDE.Core.RuleTypes import Development.IDE.Core.Shake hiding (Log, Priority, - withHieDb) + knownTargets, withHieDb) import qualified Development.IDE.GHC.Compat as Compat import Development.IDE.GHC.Compat.Core hiding (Target, TargetFile, TargetModule, - Var, Warning) + Var, Warning, getOptions) import qualified Development.IDE.GHC.Compat.Core as GHC import Development.IDE.GHC.Compat.Env hiding (Logger) import Development.IDE.GHC.Compat.Units (UnitId) @@ -151,21 +151,21 @@ instance Pretty Log where , "Cradle:" <+> viaShow cradle ] LogGetInitialGhcLibDirDefaultCradleNone -> "Couldn't load cradle. Cradle not found." - LogHieDbRetry delay maxDelay maxRetryCount e -> + LogHieDbRetry delay maxDelay retriesRemaining e -> nest 2 $ vcat [ "Retrying hiedb action..." , "delay:" <+> pretty delay , "maximum delay:" <+> pretty maxDelay - , "retries remaining:" <+> pretty maxRetryCount + , "retries remaining:" <+> pretty retriesRemaining , "SQLite error:" <+> pretty (displayException e) ] - LogHieDbRetriesExhausted baseDelay maxDelay maxRetryCount e -> + LogHieDbRetriesExhausted baseDelay maxDelay retriesRemaining e -> nest 2 $ vcat [ "Retries exhausted for hiedb action." , "base delay:" <+> pretty baseDelay , "maximum delay:" <+> pretty maxDelay - , "retries remaining:" <+> pretty maxRetryCount + , "retries remaining:" <+> pretty retriesRemaining , "Exception:" <+> pretty (displayException e) ] LogHieDbWriterThreadSQLiteError e -> nest 2 $ @@ -202,7 +202,7 @@ instance Pretty Log where "Cradle:" <+> viaShow cradle LogNewComponentCache componentCache -> "New component cache HscEnvEq:" <+> viaShow componentCache - LogHieBios log -> pretty log + LogHieBios msg -> pretty msg -- | Bump this version number when making changes to the format of the data stored in hiedb hiedbDataVersion :: String @@ -266,17 +266,16 @@ loadWithImplicitCradle mHieYaml rootDir = do getInitialGhcLibDirDefault :: Recorder (WithPriority Log) -> FilePath -> IO (Maybe LibDir) getInitialGhcLibDirDefault recorder rootDir = do - let log = logWith recorder hieYaml <- findCradle def rootDir cradle <- loadCradle def hieYaml rootDir libDirRes <- getRuntimeGhcLibDir (toCologActionWithPrio (cmapWithPrio LogHieBios recorder)) cradle case libDirRes of CradleSuccess libdir -> pure $ Just $ LibDir libdir CradleFail err -> do - log Error $ LogGetInitialGhcLibDirDefaultCradleFail err rootDir hieYaml cradle + logWith recorder Error $ LogGetInitialGhcLibDirDefaultCradleFail err rootDir hieYaml cradle pure Nothing CradleNone -> do - log Warning LogGetInitialGhcLibDirDefaultCradleNone + logWith recorder Warning LogGetInitialGhcLibDirDefaultCradleNone pure Nothing -- | Sets `unsafeGlobalDynFlags` on using the hie-bios cradle and returns the GHC libdir @@ -304,28 +303,26 @@ retryOnException -> g -- ^ random number generator -> m a -- ^ action that may throw exception -> m a -retryOnException exceptionPred recorder maxDelay !baseDelay !maxRetryCount rng action = do +retryOnException exceptionPred recorder maxDelay !baseDelay !maxTimesRetry rng action = do result <- tryJust exceptionPred action case result of Left e - | maxRetryCount > 0 -> do + | maxTimesRetry > 0 -> do -- multiply by 2 because baseDelay is midpoint of uniform range let newBaseDelay = min maxDelay (baseDelay * 2) let (delay, newRng) = Random.randomR (0, newBaseDelay) rng - let newMaxRetryCount = maxRetryCount - 1 + let newMaxTimesRetry = maxTimesRetry - 1 liftIO $ do - log Warning $ LogHieDbRetry delay maxDelay newMaxRetryCount (toException e) + logWith recorder Warning $ LogHieDbRetry delay maxDelay newMaxTimesRetry (toException e) threadDelay delay - retryOnException exceptionPred recorder maxDelay newBaseDelay newMaxRetryCount newRng action + retryOnException exceptionPred recorder maxDelay newBaseDelay newMaxTimesRetry newRng action | otherwise -> do liftIO $ do - log Warning $ LogHieDbRetriesExhausted baseDelay maxDelay maxRetryCount (toException e) + logWith recorder Warning $ LogHieDbRetriesExhausted baseDelay maxDelay maxTimesRetry (toException e) throwIO e Right b -> pure b - where - log = logWith recorder -- | in microseconds oneSecond :: Int @@ -380,21 +377,19 @@ runWithDb recorder fp k = do withAsync (writerThread withWriteDbRetryable chan) $ \_ -> do withHieDb fp (\readDb -> k (makeWithHieDbRetryable recorder rng readDb) chan) where - log = logWith recorder - writerThread :: WithHieDb -> IndexQueue -> IO () writerThread withHieDbRetryable chan = do -- Clear the index of any files that might have been deleted since the last run _ <- withHieDbRetryable deleteMissingRealFiles _ <- withHieDbRetryable garbageCollectTypeNames forever $ do - k <- atomically $ readTQueue chan + l <- atomically $ readTQueue chan -- TODO: probably should let exceptions be caught/logged/handled by top level handler - k withHieDbRetryable + l withHieDbRetryable `Safe.catch` \e@SQLError{} -> do - log Error $ LogHieDbWriterThreadSQLiteError e - `Safe.catchAny` \e -> do - log Error $ LogHieDbWriterThreadException e + logWith recorder Error $ LogHieDbWriterThreadSQLiteError e + `Safe.catchAny` \f -> do + logWith recorder Error $ LogHieDbWriterThreadException f getHieDbLoc :: FilePath -> IO FilePath @@ -557,11 +552,11 @@ loadSessionWithOptions recorder SessionLoadingOptions{..} dir = do -- scratch again (for now) -- It's important to keep the same NameCache though for reasons -- that I do not fully understand - log Info $ LogMakingNewHscEnv inplace - hscEnv <- emptyHscEnv ideNc libDir + logWith recorder Info $ LogMakingNewHscEnv inplace + hscEnvB <- emptyHscEnv ideNc libDir !newHscEnv <- -- Add the options for the current component to the HscEnv - evalGhcEnv hscEnv $ do + evalGhcEnv hscEnvB $ do _ <- setSessionDynFlags #if !MIN_VERSION_ghc(9,3,0) $ setHomeUnitId_ fakeUid @@ -598,7 +593,7 @@ loadSessionWithOptions recorder SessionLoadingOptions{..} dir = do res <- loadDLL hscEnv "libm.so.6" case res of Nothing -> pure () - Just err -> log Error $ LogDLLLoadError err + Just err -> logWith recorder Error $ LogDLLLoadError err -- Make a map from unit-id to DynFlags, this is used when trying to @@ -640,21 +635,22 @@ loadSessionWithOptions recorder SessionLoadingOptions{..} dir = do let cs_exist = catMaybes (zipWith (<$) cfps' mmt) modIfaces <- uses GetModIface cs_exist -- update exports map - extras <- getShakeExtras + shakeExtras <- getShakeExtras let !exportsMap' = createExportsMap $ mapMaybe (fmap hirModIface) modIfaces - liftIO $ atomically $ modifyTVar' (exportsMap extras) (exportsMap' <>) + liftIO $ atomically $ modifyTVar' (exportsMap shakeExtras) (exportsMap' <>) return (second Map.keys res) let consultCradle :: Maybe FilePath -> FilePath -> IO (IdeResult HscEnvEq, [FilePath]) consultCradle hieYaml cfp = do - lfp <- flip makeRelative cfp <$> getCurrentDirectory - log Info $ LogCradlePath lfp + lfpLog <- flip makeRelative cfp <$> getCurrentDirectory + logWith recorder Info $ LogCradlePath lfpLog when (isNothing hieYaml) $ - log Warning $ LogCradleNotFound lfp + logWith recorder Warning $ LogCradleNotFound lfpLog cradle <- loadCradle hieYaml dir + -- TODO: Why are we repeating the same command we have on line 646? lfp <- flip makeRelative cfp <$> getCurrentDirectory when optTesting $ mRunLspT lspEnv $ @@ -670,7 +666,7 @@ loadSessionWithOptions recorder SessionLoadingOptions{..} dir = do addTag "result" (show res) return res - log Debug $ LogSessionLoadingResult eopts + logWith recorder Debug $ LogSessionLoadingResult eopts case eopts of -- The cradle gave us some options so get to work turning them -- into and HscEnv. @@ -730,11 +726,9 @@ loadSessionWithOptions recorder SessionLoadingOptions{..} dir = do opts <- liftIO $ join $ mask_ $ modifyVar runningCradle $ \as -> do -- If the cradle is not finished, then wait for it to finish. void $ wait as - as <- async $ getOptions file - return (as, wait as) + asyncRes <- async $ getOptions file + return (asyncRes, wait asyncRes) pure opts - where - log = logWith recorder -- | Run the specific cradle on a specific FilePath via hie-bios. -- This then builds dependencies or whatever based on the cradle, gets the @@ -790,14 +784,14 @@ fromTargetId :: [FilePath] -- ^ import paths -> DependencyInfo -> IO [TargetDetails] -- For a target module we consider all the import paths -fromTargetId is exts (GHC.TargetModule mod) env dep = do - let fps = [i moduleNameSlashes mod -<.> ext <> boot +fromTargetId is exts (GHC.TargetModule modName) env dep = do + let fps = [i moduleNameSlashes modName -<.> ext <> boot | ext <- exts , i <- is , boot <- ["", "-boot"] ] locs <- mapM (fmap toNormalizedFilePath' . makeAbsolute) fps - return [TargetDetails (TargetModule mod) env dep locs] + return [TargetDetails (TargetModule modName) env dep locs] -- For a 'TargetFile' we consider all the possible module names fromTargetId _ _ (GHC.TargetFile f _) env deps = do nf <- toNormalizedFilePath' <$> makeAbsolute f @@ -1062,11 +1056,11 @@ getDependencyInfo :: [FilePath] -> IO DependencyInfo getDependencyInfo fs = Map.fromList <$> mapM do_one fs where - tryIO :: IO a -> IO (Either IOException a) - tryIO = Safe.try + safeTryIO :: IO a -> IO (Either IOException a) + safeTryIO = Safe.try do_one :: FilePath -> IO (FilePath, Maybe UTCTime) - do_one fp = (fp,) . eitherToMaybe <$> tryIO (getModificationTime fp) + do_one fp = (fp,) . eitherToMaybe <$> safeTryIO (getModificationTime fp) -- | This function removes all the -package flags which refer to packages we -- are going to deal with ourselves. For example, if a executable depends diff --git a/ghcide/src/Development/IDE/Core/Compile.hs b/ghcide/src/Development/IDE/Core/Compile.hs index 7b10289099..9e6e762406 100644 --- a/ghcide/src/Development/IDE/Core/Compile.hs +++ b/ghcide/src/Development/IDE/Core/Compile.hs @@ -39,6 +39,7 @@ module Development.IDE.Core.Compile , shareUsages ) where +import Prelude hiding (mod) import Control.Monad.IO.Class import Control.Concurrent.Extra import Control.Concurrent.STM.Stats hiding (orElse) @@ -46,7 +47,7 @@ import Control.DeepSeq (NFData (..), force, rnf) import Control.Exception (evaluate) import Control.Exception.Safe -import Control.Lens hiding (List, (<.>)) +import Control.Lens hiding (List, (<.>), pre) import Control.Monad.Except import Control.Monad.Extra import Control.Monad.Trans.Except @@ -96,7 +97,7 @@ import GHC (ForeignHValue, parsedSource) import qualified GHC.LanguageExtensions as LangExt import GHC.Serialized -import HieDb +import HieDb hiding (withHieDb) import qualified Language.LSP.Server as LSP import Language.LSP.Protocol.Types (DiagnosticTag (..)) import qualified Language.LSP.Protocol.Types as LSP @@ -200,14 +201,14 @@ typecheckModule (IdeDefer defer) hsc tc_helpers pm = do (initPlugins hsc modSummary) case initialized of Left errs -> return (errs, Nothing) - Right (modSummary', hsc) -> do + Right (modSummary', hscEnv) -> do (warnings, etcm) <- withWarnings sourceTypecheck $ \tweak -> let - session = tweak (hscSetFlags dflags hsc) + session = tweak (hscSetFlags dflags hscEnv) -- TODO: maybe settings ms_hspp_opts is unnecessary? mod_summary'' = modSummary' { ms_hspp_opts = hsc_dflags session} in - catchSrcErrors (hsc_dflags hsc) sourceTypecheck $ do + catchSrcErrors (hsc_dflags hscEnv) sourceTypecheck $ do tcRnModule session tc_helpers $ demoteIfDefer pm{pm_mod_summary = mod_summary''} let errorPipeline = unDefer . hideDiag dflags . tagDiag diags = map errorPipeline warnings @@ -342,8 +343,8 @@ captureSplicesAndDeps TypecheckHelpers{..} env k = do ; moduleLocs <- readIORef (hsc_FC hsc_env) #endif ; lbs <- getLinkables [toNormalizedFilePath' file - | mod <- mods_transitive_list - , let ifr = fromJust $ lookupInstalledModuleEnv moduleLocs mod + | installedMod <- mods_transitive_list + , let ifr = fromJust $ lookupInstalledModuleEnv moduleLocs installedMod file = case ifr of InstalledFound loc _ -> fromJust $ ml_hs_file loc @@ -374,7 +375,7 @@ captureSplicesAndDeps TypecheckHelpers{..} env k = do -- because boot files don't have linkables we can load, and we will fail if we try to look -- for them nodeKeyToInstalledModule (NodeKey_Module (ModNodeKeyWithUid (GWIB _ IsBoot) _)) = Nothing - nodeKeyToInstalledModule (NodeKey_Module (ModNodeKeyWithUid (GWIB mod _) uid)) = Just $ mkModule uid mod + nodeKeyToInstalledModule (NodeKey_Module (ModNodeKeyWithUid (GWIB moduleName _) uid)) = Just $ mkModule uid moduleName nodeKeyToInstalledModule _ = Nothing moduleToNodeKey :: Module -> NodeKey moduleToNodeKey mod = NodeKey_Module $ ModNodeKeyWithUid (GWIB (moduleName mod) NotBoot) (moduleUnitId mod) @@ -441,8 +442,8 @@ tcRnModule hsc_env tc_helpers pmod = do hsc_env_tmp = hscSetFlags (ms_hspp_opts ms) hsc_env ((tc_gbl_env', mrn_info), splices, mod_env) - <- captureSplicesAndDeps tc_helpers hsc_env_tmp $ \hsc_env_tmp -> - do hscTypecheckRename hsc_env_tmp ms $ + <- captureSplicesAndDeps tc_helpers hsc_env_tmp $ \hscEnvTmp -> + do hscTypecheckRename hscEnvTmp ms $ HsParsedModule { hpm_module = parsedSource pmod, hpm_src_files = pm_extra_src_files pmod, hpm_annotations = pm_annotations pmod } @@ -559,9 +560,9 @@ mkHiFileResultCompile se session' tcm simplified_guts = catchErrs $ do -- The serialized file however is much more compact and only requires a few -- hundred megabytes of memory total even in a large project with 1000s of -- modules - (core_file, !core_hash2) <- readBinCoreFile (mkUpdater $ hsc_NC session) core_fp + (coreFile, !core_hash2) <- readBinCoreFile (mkUpdater $ hsc_NC session) core_fp pure $ assert (core_hash1 == core_hash2) - $ Just (core_file, fingerprintToBS core_hash2) + $ Just (coreFile, fingerprintToBS core_hash2) -- Verify core file by roundtrip testing and comparison IdeOptions{optVerifyCoreFile} <- getIdeOptionsIO se @@ -916,8 +917,8 @@ indexHieFile se mod_summary srcPath !hash hf = do -- We are now in the worker thread -- Check if a newer index of this file has been scheduled, and if so skip this one newerScheduled <- atomically $ do - pending <- readTVar indexPending - pure $ case HashMap.lookup srcPath pending of + pendingOps <- readTVar indexPending + pure $ case HashMap.lookup srcPath pendingOps of Nothing -> False -- If the hash in the pending list doesn't match the current hash, then skip Just pendingHash -> pendingHash /= hash @@ -963,8 +964,8 @@ indexHieFile se mod_summary srcPath !hash hf = do progressPct :: LSP.UInt progressPct = floor $ 100 * progressFrac - whenJust (lspEnv se) $ \env -> whenJust tok $ \tok -> LSP.runLspT env $ - LSP.sendNotification LSP.SMethod_Progress $ LSP.ProgressParams tok $ + whenJust (lspEnv se) $ \env -> whenJust tok $ \token -> LSP.runLspT env $ + LSP.sendNotification LSP.SMethod_Progress $ LSP.ProgressParams token $ toJSON $ case style of Percentage -> LSP.WorkDoneProgressReport @@ -1004,8 +1005,8 @@ indexHieFile se mod_summary srcPath !hash hf = do whenJust mdone $ \done -> modifyVar_ indexProgressToken $ \tok -> do whenJust (lspEnv se) $ \env -> LSP.runLspT env $ - whenJust tok $ \tok -> - LSP.sendNotification LSP.SMethod_Progress $ LSP.ProgressParams tok $ + whenJust tok $ \token -> + LSP.sendNotification LSP.SMethod_Progress $ LSP.ProgressParams token $ toJSON $ LSP.WorkDoneProgressEnd { _kind = LSP.AString @"end" @@ -1134,11 +1135,11 @@ getModSummaryFromImports -> UTCTime -> Maybe Util.StringBuffer -> ExceptT [FileDiagnostic] IO ModSummaryResult -getModSummaryFromImports env fp modTime contents = do +getModSummaryFromImports env fp modTime mContents = do - (contents, opts, env, src_hash) <- preprocessor env fp contents + (contents, opts, ppEnv, src_hash) <- preprocessor env fp mContents - let dflags = hsc_dflags env + let dflags = hsc_dflags ppEnv -- The warns will hopefully be reported when we actually parse the module (_warns, L main_loc hsmod) <- parseHeader dflags fp contents @@ -1172,7 +1173,7 @@ getModSummaryFromImports env fp modTime contents = do msrImports = implicit_imports ++ imps #if MIN_VERSION_ghc (9,3,0) - rn_pkg_qual = renameRawPkgQual (hsc_unit_env env) + rn_pkg_qual = renameRawPkgQual (hsc_unit_env ppEnv) rn_imps = fmap (\(pk, lmn@(L _ mn)) -> (rn_pkg_qual mn pk, lmn)) srcImports = rn_imps $ map convImport src_idecls textualImports = rn_imps $ map convImport (implicit_imports ++ ordinary_imps) @@ -1194,7 +1195,7 @@ getModSummaryFromImports env fp modTime contents = do then mkHomeModLocation dflags (pathToModuleName fp) fp else mkHomeModLocation dflags mod fp - let modl = mkHomeModule (hscHomeUnit env) mod + let modl = mkHomeModule (hscHomeUnit ppEnv) mod sourceType = if "-boot" `isSuffixOf` takeExtension fp then HsBootFile else HsSrcFile msrModSummary2 = ModSummary @@ -1222,7 +1223,7 @@ getModSummaryFromImports env fp modTime contents = do } msrFingerprint <- liftIO $ computeFingerprint opts msrModSummary2 - (msrModSummary, msrHscEnv) <- liftIO $ initPlugins env msrModSummary2 + (msrModSummary, msrHscEnv) <- liftIO $ initPlugins ppEnv msrModSummary2 return ModSummaryResult{..} where -- Compute a fingerprint from the contents of `ModSummary`, @@ -1310,7 +1311,7 @@ parseFileContents env customPreprocessor filename ms = do let preproc_warnings = diagFromStrings sourceParser DiagnosticSeverity_Warning preproc_warns (parsed', msgs) <- liftIO $ applyPluginsParsedResultAction env dflags ms hpm_annotations parsed psMessages - let (warns, errs) = renderMessages msgs + let (warns, errors) = renderMessages msgs -- Just because we got a `POk`, it doesn't mean there -- weren't errors! To clarify, the GHC parser @@ -1321,8 +1322,8 @@ parseFileContents env customPreprocessor filename ms = do -- further errors/warnings can be collected). Fatal -- errors are those from which a parse tree just can't -- be produced. - unless (null errs) $ - throwE $ diagFromErrMsgs sourceParser dflags errs + unless (null errors) $ + throwE $ diagFromErrMsgs sourceParser dflags errors -- To get the list of extra source files, we take the list @@ -1527,10 +1528,10 @@ loadInterface session ms linkableNeeded RecompilationInfo{..} = do Just msg -> do_regenerate msg Nothing | isJust linkableNeeded -> handleErrs $ do - (core_file@CoreFile{cf_iface_hash}, core_hash) <- liftIO $ + (coreFile@CoreFile{cf_iface_hash}, core_hash) <- liftIO $ readBinCoreFile (mkUpdater $ hsc_NC session) core_file if cf_iface_hash == getModuleHash iface - then return ([], Just $ mkHiFileResult ms iface details runtime_deps (Just (core_file, fingerprintToBS core_hash))) + then return ([], Just $ mkHiFileResult ms iface details runtime_deps (Just (coreFile, fingerprintToBS core_hash))) else do_regenerate (recompBecause "Core file out of date (doesn't match iface hash)") | otherwise -> return ([], Just $ mkHiFileResult ms iface details runtime_deps Nothing) where handleErrs = flip catches @@ -1712,7 +1713,7 @@ lookupName :: HscEnv -> IO (Maybe TyThing) lookupName _ name | Nothing <- nameModule_maybe name = pure Nothing -lookupName hsc_env name = handle $ do +lookupName hsc_env name = exceptionHandle $ do #if MIN_VERSION_ghc(9,2,0) mb_thing <- liftIO $ lookupType hsc_env name #else @@ -1732,7 +1733,7 @@ lookupName hsc_env name = handle $ do Util.Succeeded x -> return (Just x) _ -> return Nothing where - handle x = x `catch` \(_ :: IOEnvFailure) -> pure Nothing + exceptionHandle x = x `catch` \(_ :: IOEnvFailure) -> pure Nothing pathToModuleName :: FilePath -> ModuleName pathToModuleName = mkModuleName . map rep diff --git a/ghcide/src/Development/IDE/Core/FileExists.hs b/ghcide/src/Development/IDE/Core/FileExists.hs index b7e568d0d6..7a3d9cdd60 100644 --- a/ghcide/src/Development/IDE/Core/FileExists.hs +++ b/ghcide/src/Development/IDE/Core/FileExists.hs @@ -95,8 +95,8 @@ data Log instance Pretty Log where pretty = \case - LogFileStore log -> pretty log - LogShake log -> pretty log + LogFileStore msg -> pretty msg + LogShake msg -> pretty msg -- | Grab the current global value of 'FileExistsMap' without acquiring a dependency getFileExistsMapUntracked :: Action FileExistsMap diff --git a/ghcide/src/Development/IDE/Core/FileStore.hs b/ghcide/src/Development/IDE/Core/FileStore.hs index 7238d76519..a780fda0b7 100644 --- a/ghcide/src/Development/IDE/Core/FileStore.hs +++ b/ghcide/src/Development/IDE/Core/FileStore.hs @@ -93,7 +93,7 @@ instance Pretty Log where <+> viaShow path <> ":" <+> pretty (fmap (fmap show) reverseDepPaths) - LogShake log -> pretty log + LogShake msg -> pretty msg addWatchedFileRule :: Recorder (WithPriority Log) -> (NormalizedFilePath -> Action Bool) -> Rules () addWatchedFileRule recorder isWatched = defineNoDiagnostics (cmapWithPrio LogShake recorder) $ \AddWatchedFile f -> do @@ -240,11 +240,10 @@ typecheckParents recorder state nfp = void $ shakeEnqueue (shakeExtras state) pa typecheckParentsAction :: Recorder (WithPriority Log) -> NormalizedFilePath -> Action () typecheckParentsAction recorder nfp = do revs <- transitiveReverseDependencies nfp <$> useNoFile_ GetModuleGraph - let log = logWith recorder case revs of - Nothing -> log Info $ LogCouldNotIdentifyReverseDeps nfp + Nothing -> logWith recorder Info $ LogCouldNotIdentifyReverseDeps nfp Just rs -> do - log Info $ LogTypeCheckingReverseDeps nfp revs + logWith recorder Info $ LogTypeCheckingReverseDeps nfp revs void $ uses GetModIface rs -- | Note that some keys have been modified and restart the session diff --git a/ghcide/src/Development/IDE/Core/OfInterest.hs b/ghcide/src/Development/IDE/Core/OfInterest.hs index 17858544c2..599947659b 100644 --- a/ghcide/src/Development/IDE/Core/OfInterest.hs +++ b/ghcide/src/Development/IDE/Core/OfInterest.hs @@ -55,7 +55,7 @@ data Log = LogShake Shake.Log instance Pretty Log where pretty = \case - LogShake log -> pretty log + LogShake msg -> pretty msg newtype OfInterestVar = OfInterestVar (Var (HashMap NormalizedFilePath FileOfInterestStatus)) diff --git a/ghcide/src/Development/IDE/Core/PositionMapping.hs b/ghcide/src/Development/IDE/Core/PositionMapping.hs index 5dccdcf8d2..82d8334c87 100644 --- a/ghcide/src/Development/IDE/Core/PositionMapping.hs +++ b/ghcide/src/Development/IDE/Core/PositionMapping.hs @@ -222,6 +222,6 @@ deltaFromDiff (T.lines -> old) (T.lines -> new) = -- -1 for unsuccessful mapping go :: [Diff T.Text] -> Int -> Int -> ([Int], [Int]) go [] _ _ = ([],[]) - go (Both _ _ : xs) !lold !lnew = bimap (lnew :) (lold :) $ go xs (lold+1) (lnew+1) - go (First _ : xs) !lold !lnew = first (-1 :) $ go xs (lold+1) lnew - go (Second _ : xs) !lold !lnew = second (-1 :) $ go xs lold (lnew+1) + go (Both _ _ : xs) !glold !glnew = bimap (glnew :) (glold :) $ go xs (glold+1) (glnew+1) + go (First _ : xs) !glold !glnew = first (-1 :) $ go xs (glold+1) glnew + go (Second _ : xs) !glold !glnew = second (-1 :) $ go xs glold (glnew+1) diff --git a/ghcide/src/Development/IDE/Core/Preprocessor.hs b/ghcide/src/Development/IDE/Core/Preprocessor.hs index 24bc7beb3e..57bc1a12ed 100644 --- a/ghcide/src/Development/IDE/Core/Preprocessor.hs +++ b/ghcide/src/Development/IDE/Core/Preprocessor.hs @@ -54,17 +54,17 @@ preprocessor env filename mbContents = do !src_hash <- liftIO $ Util.fingerprintFromStringBuffer contents -- Perform cpp - (opts, env) <- ExceptT $ parsePragmasIntoHscEnv env filename contents - let dflags = hsc_dflags env - let logger = hsc_logger env - (isOnDisk, contents, opts, env) <- + (opts, pEnv) <- ExceptT $ parsePragmasIntoHscEnv env filename contents + let dflags = hsc_dflags pEnv + let logger = hsc_logger pEnv + (newIsOnDisk, newContents, newOpts, newEnv) <- if not $ xopt LangExt.Cpp dflags then - return (isOnDisk, contents, opts, env) + return (isOnDisk, contents, opts, pEnv) else do cppLogs <- liftIO $ newIORef [] let newLogger = pushLogHook (const (logActionCompat $ logAction cppLogs)) logger - contents <- ExceptT - $ (Right <$> (runCpp (putLogHook newLogger env) filename + con <- ExceptT + $ (Right <$> (runCpp (putLogHook newLogger pEnv) filename $ if isOnDisk then Nothing else Just contents)) `catch` ( \(e :: Util.GhcException) -> do @@ -73,25 +73,25 @@ preprocessor env filename mbContents = do [] -> throw e diags -> return $ Left diags ) - (opts, env) <- ExceptT $ parsePragmasIntoHscEnv env filename contents - return (False, contents, opts, env) + (options, hscEnv) <- ExceptT $ parsePragmasIntoHscEnv pEnv filename con + return (False, con, options, hscEnv) -- Perform preprocessor if not $ gopt Opt_Pp dflags then - return (contents, opts, env, src_hash) + return (newContents, newOpts, newEnv, src_hash) else do - contents <- liftIO $ runPreprocessor env filename $ if isOnDisk then Nothing else Just contents - (opts, env) <- ExceptT $ parsePragmasIntoHscEnv env filename contents - return (contents, opts, env, src_hash) + con <- liftIO $ runPreprocessor newEnv filename $ if newIsOnDisk then Nothing else Just newContents + (options, hscEnv) <- ExceptT $ parsePragmasIntoHscEnv newEnv filename con + return (con, options, hscEnv, src_hash) where logAction :: IORef [CPPLog] -> LogActionCompat logAction cppLogs dflags _reason severity srcSpan _style msg = do #if MIN_VERSION_ghc(9,3,0) - let log = CPPLog (fromMaybe SevWarning severity) srcSpan $ T.pack $ renderWithContext (log_default_user_context dflags) msg + let cppLog = CPPLog (fromMaybe SevWarning severity) srcSpan $ T.pack $ renderWithContext (log_default_user_context dflags) msg #else - let log = CPPLog severity srcSpan $ T.pack $ showSDoc dflags msg + let cppLog = CPPLog severity srcSpan $ T.pack $ showSDoc dflags msg #endif - modifyIORef cppLogs (log :) + modifyIORef cppLogs (cppLog :) @@ -118,12 +118,12 @@ diagsFromCPPLogs filename logs = -- informational log messages and attaches them to the initial log message. go :: [CPPDiag] -> [CPPLog] -> [CPPDiag] go acc [] = reverse $ map (\d -> d {cdMessage = reverse $ cdMessage d}) acc - go acc (CPPLog sev (RealSrcSpan span _) msg : logs) = - let diag = CPPDiag (realSrcSpanToRange span) (toDSeverity sev) [msg] - in go (diag : acc) logs - go (diag : diags) (CPPLog _sev (UnhelpfulSpan _) msg : logs) = - go (diag {cdMessage = msg : cdMessage diag} : diags) logs - go [] (CPPLog _sev (UnhelpfulSpan _) _msg : logs) = go [] logs + go acc (CPPLog sev (RealSrcSpan rSpan _) msg : gLogs) = + let diag = CPPDiag (realSrcSpanToRange rSpan) (toDSeverity sev) [msg] + in go (diag : acc) gLogs + go (diag : diags) (CPPLog _sev (UnhelpfulSpan _) msg : gLogs) = + go (diag {cdMessage = msg : cdMessage diag} : diags) gLogs + go [] (CPPLog _sev (UnhelpfulSpan _) _msg : gLogs) = go [] gLogs cppDiagToDiagnostic :: CPPDiag -> Diagnostic cppDiagToDiagnostic d = Diagnostic @@ -196,12 +196,12 @@ runLhs env filename contents = withTempDir $ \dir -> do -- | Run CPP on a file runCpp :: HscEnv -> FilePath -> Maybe Util.StringBuffer -> IO Util.StringBuffer -runCpp env0 filename contents = withTempDir $ \dir -> do +runCpp env0 filename mbContents = withTempDir $ \dir -> do let out = dir takeFileName filename <.> "out" let dflags1 = addOptP "-D__GHCIDE__" (hsc_dflags env0) let env1 = hscSetFlags dflags1 env0 - case contents of + case mbContents of Nothing -> do -- Happy case, file is not modified, so run CPP on it in-place -- which also makes things like relative #include files work @@ -225,21 +225,21 @@ runCpp env0 filename contents = withTempDir $ \dir -> do -- Fix up the filename in lines like: -- # 1 "C:/Temp/extra-dir-914611385186/___GHCIDE_MAGIC___" let tweak x - | Just x <- stripPrefix "# " x - , "___GHCIDE_MAGIC___" `isInfixOf` x - , let num = takeWhile (not . isSpace) x + | Just y <- stripPrefix "# " x + , "___GHCIDE_MAGIC___" `isInfixOf` y + , let num = takeWhile (not . isSpace) y -- important to use /, and never \ for paths, even on Windows, since then C escapes them -- and GHC gets all confused - = "# " <> num <> " \"" <> map (\x -> if isPathSeparator x then '/' else x) filename <> "\"" + = "# " <> num <> " \"" <> map (\z -> if isPathSeparator z then '/' else z) filename <> "\"" | otherwise = x Util.stringToStringBuffer . unlines . map tweak . lines <$> readFileUTF8' out -- | Run a preprocessor on a file runPreprocessor :: HscEnv -> FilePath -> Maybe Util.StringBuffer -> IO Util.StringBuffer -runPreprocessor env filename contents = withTempDir $ \dir -> do +runPreprocessor env filename mbContents = withTempDir $ \dir -> do let out = dir takeFileName filename <.> "out" - inp <- case contents of + inp <- case mbContents of Nothing -> return filename Just contents -> do let inp = dir takeFileName filename <.> "hs" diff --git a/ghcide/src/Development/IDE/Core/ProgressReporting.hs b/ghcide/src/Development/IDE/Core/ProgressReporting.hs index be57426e3d..83d4670782 100644 --- a/ghcide/src/Development/IDE/Core/ProgressReporting.hs +++ b/ghcide/src/Development/IDE/Core/ProgressReporting.hs @@ -18,7 +18,7 @@ import Control.Concurrent.STM.Stats (TVar, atomicallyNamed, modifyTVar', newTVarIO, readTVarIO) import Control.Concurrent.Strict -import Control.Monad.Extra +import Control.Monad.Extra hiding (loop) import Control.Monad.IO.Class import Control.Monad.Trans.Class (lift) import Data.Aeson (ToJSON (toJSON)) @@ -136,9 +136,9 @@ delayedProgressReporting before after (Just lspEnv) optProgressStyle = do ready <- waitBarrier b LSP.runLspT lspEnv $ for_ ready $ const $ bracket_ (start u) (stop u) (loop u 0) where - start id = LSP.sendNotification SMethod_Progress $ + start token = LSP.sendNotification SMethod_Progress $ LSP.ProgressParams - { _token = id + { _token = token , _value = toJSON $ WorkDoneProgressBegin { _kind = AString @"begin" , _title = "Processing" @@ -147,9 +147,9 @@ delayedProgressReporting before after (Just lspEnv) optProgressStyle = do , _percentage = Nothing } } - stop id = LSP.sendNotification SMethod_Progress + stop token = LSP.sendNotification SMethod_Progress LSP.ProgressParams - { _token = id + { _token = token , _value = toJSON $ WorkDoneProgressEnd { _kind = AString @"end" , _message = Nothing @@ -157,11 +157,11 @@ delayedProgressReporting before after (Just lspEnv) optProgressStyle = do } loop _ _ | optProgressStyle == NoProgress = forever $ liftIO $ threadDelay maxBound - loop id prevPct = do + loop token prevPct = do done <- liftIO $ readTVarIO doneVar todo <- liftIO $ readTVarIO todoVar liftIO $ sleep after - if todo == 0 then loop id 0 else do + if todo == 0 then loop token 0 else do let nextFrac :: Double nextFrac = fromIntegral done / fromIntegral todo @@ -170,7 +170,7 @@ delayedProgressReporting before after (Just lspEnv) optProgressStyle = do when (nextPct /= prevPct) $ LSP.sendNotification SMethod_Progress $ LSP.ProgressParams - { _token = id + { _token = token , _value = case optProgressStyle of Explicit -> toJSON $ WorkDoneProgressReport { _kind = AString @"report" @@ -186,7 +186,7 @@ delayedProgressReporting before after (Just lspEnv) optProgressStyle = do } NoProgress -> error "unreachable" } - loop id nextPct + loop token nextPct updateStateForFile inProgress file = actionBracket (f succ) (const $ f pred) . const -- This functions are deliberately eta-expanded to avoid space leaks. diff --git a/ghcide/src/Development/IDE/Core/Rules.hs b/ghcide/src/Development/IDE/Core/Rules.hs index 8a3c9cffe0..4ac2368664 100644 --- a/ghcide/src/Development/IDE/Core/Rules.hs +++ b/ghcide/src/Development/IDE/Core/Rules.hs @@ -61,6 +61,7 @@ module Development.IDE.Core.Rules( DisplayTHWarning(..), ) where +import Prelude hiding (mod) import Control.Applicative import Control.Concurrent.Async (concurrently) import Control.Concurrent.Strict @@ -114,7 +115,7 @@ import Development.IDE.GHC.Compat hiding TargetId(..), loadInterface, Var, - (<+>)) + (<+>), settings) import qualified Development.IDE.GHC.Compat as Compat hiding (vcat, nest) import qualified Development.IDE.GHC.Compat.Util as Util import Development.IDE.GHC.Error @@ -181,7 +182,7 @@ data Log instance Pretty Log where pretty = \case - LogShake log -> pretty log + LogShake msg -> pretty msg LogReindexingHieFile path -> "Re-indexing hie file for" <+> pretty (fromNormalizedFilePath path) LogLoadingHieFile path -> @@ -333,10 +334,10 @@ getParsedModuleWithCommentsRule recorder = let ms' = withoutOption Opt_Haddock $ withOption Opt_KeepRawTokenStream ms modify_dflags <- getModifyDynFlags dynFlagsModifyParser - let ms = ms' { ms_hspp_opts = modify_dflags $ ms_hspp_opts ms' } + let ms'' = ms' { ms_hspp_opts = modify_dflags $ ms_hspp_opts ms' } reset_ms pm = pm { pm_mod_summary = ms' } - liftIO $ fmap (fmap reset_ms) $ snd <$> getParsedModuleDefinition hsc opt file ms + liftIO $ fmap (fmap reset_ms) $ snd <$> getParsedModuleDefinition hsc opt file ms'' getModifyDynFlags :: (DynFlagsModifications -> a) -> Action a getModifyDynFlags f = do @@ -369,7 +370,7 @@ getLocatedImportsRule recorder = let import_dirs = deps env_eq let dflags = hsc_dflags env isImplicitCradle = isNothing $ envImportPaths env_eq - dflags <- return $ if isImplicitCradle + dflags' <- return $ if isImplicitCradle then addRelativeImport file (moduleName $ ms_mod ms) dflags else dflags opt <- getIdeOptions @@ -390,7 +391,7 @@ getLocatedImportsRule recorder = | otherwise = return Nothing (diags, imports') <- fmap unzip $ forM imports $ \(isSource, (mbPkgName, modName)) -> do - diagOrImp <- locateModule (hscSetFlags dflags env) import_dirs (optExtensions opt) getTargetFor modName mbPkgName isSource + diagOrImp <- locateModule (hscSetFlags dflags' env) import_dirs (optExtensions opt) getTargetFor modName mbPkgName isSource case diagOrImp of Left diags -> pure (diags, Just (modName, Nothing)) Right (FileImport path) -> pure ([], Just (modName, Just path)) @@ -437,16 +438,16 @@ rawDependencyInformation fs = do go :: NormalizedFilePath -- ^ Current module being processed -> Maybe ModSummary -- ^ ModSummary of the module -> RawDepM FilePathId - go f msum = do + go f mbMSum = do -- First check to see if we have already processed the FilePath -- If we have, just return its Id but don't update any of the state. -- Otherwise, we need to process its imports. checkAlreadyProcessed f $ do - let al = modSummaryToArtifactsLocation f msum + let al = modSummaryToArtifactsLocation f mbMSum -- Get a fresh FilePathId for the new file fId <- getFreshFid al -- Record this module and its location - whenJust msum $ \ms -> + whenJust mbMSum $ \ms -> modifyRawDepInfo (\rd -> rd { rawModuleMap = IntMap.insert (getFilePathId fId) (ShowableModule $ ms_mod ms) (rawModuleMap rd)}) @@ -535,9 +536,8 @@ reportImportCyclesRule recorder = let cycles = mapMaybe (cycleErrorInFile fileId) (toList errs) -- Convert cycles of files into cycles of module names forM cycles $ \(imp, files) -> do - modNames <- forM files $ \fileId -> do - let file = idToPath depPathIdMap fileId - getModuleName file + modNames <- forM files $ \filePathId -> + getModuleName $ idToPath depPathIdMap filePathId pure $ toDiag imp $ sort modNames where cycleErrorInFile f (PartOfCycle imp fs) | f `elem` fs = Just (imp, fs) @@ -594,8 +594,8 @@ getHieAstRuleDefinition f hsc tmr = do _ | Just asts <- masts -> do source <- getSourceFileSource f let exports = tcg_exports $ tmrTypechecked tmr - msum = tmrModSummary tmr - liftIO $ writeAndIndexHieFile hsc se msum f exports asts source + modSum = tmrModSummary tmr + liftIO $ writeAndIndexHieFile hsc se modSum f exports asts source _ -> pure [] let refmap = Compat.generateReferencesMap . Compat.getAsts <$> masts @@ -648,10 +648,9 @@ readHieFileFromDisk :: Recorder (WithPriority Log) -> FilePath -> ExceptT SomeEx readHieFileFromDisk recorder hie_loc = do nc <- asks ideNc res <- liftIO $ tryAny $ loadHieFile (mkUpdater nc) hie_loc - let log = (liftIO .) . logWith recorder case res of - Left e -> log Logger.Debug $ LogLoadingHieFileFail hie_loc e - Right _ -> log Logger.Debug $ LogLoadingHieFileSuccess hie_loc + Left e -> liftIO $ logWith recorder Logger.Debug $ LogLoadingHieFileFail hie_loc e + Right _ -> liftIO $ logWith recorder Logger.Debug $ LogLoadingHieFileSuccess hie_loc except res -- | Typechecks a module. @@ -887,12 +886,12 @@ getModIfaceFromDiskAndIndexRule recorder = -- GetModIfaceFromDisk should have written a `.hie` file, must check if it matches version in db let ms = hirModSummary x hie_loc = Compat.ml_hie_file $ ms_location ms - hash <- liftIO $ Util.getFileHash hie_loc + fingerPrint <- liftIO $ Util.getFileHash hie_loc mrow <- liftIO $ withHieDb (\hieDb -> HieDb.lookupHieFileFromSource hieDb (fromNormalizedFilePath f)) hie_loc' <- liftIO $ traverse (makeAbsolute . HieDb.hieModuleHieFile) mrow case mrow of Just row - | hash == HieDb.modInfoHash (HieDb.hieModInfo row) + | fingerPrint == HieDb.modInfoHash (HieDb.hieModInfo row) && Just hie_loc == hie_loc' -> do -- All good, the db has indexed the file @@ -909,7 +908,7 @@ getModIfaceFromDiskAndIndexRule recorder = -- can just re-index the file we read from disk Right hf -> liftIO $ do logWith recorder Logger.Debug $ LogReindexingHieFile f - indexHieFile se ms f hash hf + indexHieFile se ms f fingerPrint hf return (Just x) @@ -956,14 +955,14 @@ getModSummaryRule displayTHWarning recorder = do ms <- use GetModSummary f case ms of Just res@ModSummaryResult{..} -> do - let ms = msrModSummary { + let modSum = msrModSummary { #if !MIN_VERSION_ghc(9,3,0) ms_hs_date = error "use GetModSummary instead of GetModSummaryWithoutTimestamps", #endif ms_hspp_buf = error "use GetModSummary instead of GetModSummaryWithoutTimestamps" } fp = fingerprintToBS msrFingerprint - return (Just fp, Just res{msrModSummary = ms}) + return (Just fp, Just res{msrModSummary = modSum}) Nothing -> return (Nothing, Nothing) generateCore :: RunSimplifier -> NormalizedFilePath -> Action (IdeResult ModGuts) @@ -988,14 +987,14 @@ getModIfaceRule recorder = defineEarlyCutoff (cmapWithPrio LogShake recorder) $ hsc <- hscEnv <$> use_ GhcSessionDeps f let compile = fmap ([],) $ use GenerateCore f se <- getShakeExtras - (diags, !hiFile) <- writeCoreFileIfNeeded se hsc linkableType compile tmr - let fp = hiFileFingerPrint <$> hiFile - hiDiags <- case hiFile of + (diags, !mbHiFile) <- writeCoreFileIfNeeded se hsc linkableType compile tmr + let fp = hiFileFingerPrint <$> mbHiFile + hiDiags <- case mbHiFile of Just hiFile | OnDisk <- status , not (tmrDeferredError tmr) -> liftIO $ writeHiFile se hsc hiFile _ -> pure [] - return (fp, (diags++hiDiags, hiFile)) + return (fp, (diags++hiDiags, mbHiFile)) NotFOI -> do hiFile <- use GetModIfaceFromDiskAndIndex f let fp = hiFileFingerPrint <$> hiFile @@ -1027,22 +1026,22 @@ regenerateHiFile sess f ms compNeeded = do -- Embed haddocks in the interface file (diags, mb_pm) <- liftIO $ getParsedModuleDefinition hsc opt f (withOptHaddock ms) - (diags, mb_pm) <- + (diags', mb_pm') <- -- We no longer need to parse again if GHC version is above 9.0. https://github.com/haskell/haskell-language-server/issues/1892 if Compat.ghcVersion >= Compat.GHC90 || isJust mb_pm then do return (diags, mb_pm) else do -- if parsing fails, try parsing again with Haddock turned off - (diagsNoHaddock, mb_pm) <- liftIO $ getParsedModuleDefinition hsc opt f ms - return (mergeParseErrorsHaddock diagsNoHaddock diags, mb_pm) - case mb_pm of - Nothing -> return (diags, Nothing) + (diagsNoHaddock, mb_pm'') <- liftIO $ getParsedModuleDefinition hsc opt f ms + return (mergeParseErrorsHaddock diagsNoHaddock diags, mb_pm'') + case mb_pm' of + Nothing -> return (diags', Nothing) Just pm -> do -- Invoke typechecking directly to update it without incurring a dependency -- on the parsed module and the typecheck rules - (diags', mtmr) <- typeCheckRuleDefinition hsc pm + (diags'', mtmr) <- typeCheckRuleDefinition hsc pm case mtmr of - Nothing -> pure (diags', Nothing) + Nothing -> pure (diags'', Nothing) Just tmr -> do let compile = liftIO $ compileModule (RunSimplifier True) hsc (pm_mod_summary pm) $ tmrTypechecked tmr @@ -1050,7 +1049,7 @@ regenerateHiFile sess f ms compNeeded = do se <- getShakeExtras -- Bang pattern is important to avoid leaking 'tmr' - (diags'', !res) <- writeCoreFileIfNeeded se hsc compNeeded compile tmr + (diags''', !res) <- writeCoreFileIfNeeded se hsc compNeeded compile tmr -- Write hi file hiDiags <- case res of @@ -1059,22 +1058,22 @@ regenerateHiFile sess f ms compNeeded = do -- Write hie file. Do this before writing the .hi file to -- ensure that we always have a up2date .hie file if we have -- a .hi file - se <- getShakeExtras + se' <- getShakeExtras (gDiags, masts) <- liftIO $ generateHieAsts hsc tmr source <- getSourceFileSource f wDiags <- forM masts $ \asts -> - liftIO $ writeAndIndexHieFile hsc se (tmrModSummary tmr) f (tcg_exports $ tmrTypechecked tmr) asts source + liftIO $ writeAndIndexHieFile hsc se' (tmrModSummary tmr) f (tcg_exports $ tmrTypechecked tmr) asts source -- We don't write the `.hi` file if there are deferred errors, since we won't get -- accurate diagnostics next time if we do hiDiags <- if not $ tmrDeferredError tmr - then liftIO $ writeHiFile se hsc hiFile + then liftIO $ writeHiFile se' hsc hiFile else pure [] pure (hiDiags <> gDiags <> concat wDiags) Nothing -> pure [] - return (diags <> diags' <> diags'' <> hiDiags, res) + return (diags''' <> diags''' <> diags''' <> hiDiags, res) -- | HscEnv should have deps included already @@ -1124,7 +1123,7 @@ getLinkableRule recorder = core_t <- liftIO $ getModTime core_file case hirCoreFp of Nothing -> error "called GetLinkable for a file without a linkable" - Just (bin_core, hash) -> do + Just (bin_core, cfHash) -> do session <- use_ GhcSessionDeps f linkableType <- getLinkableType f >>= \case Nothing -> error "called GetLinkable for a file which doesn't need compilation" @@ -1161,9 +1160,9 @@ getLinkableRule recorder = --just before returning it to be loaded. This has a substantial effect on recompile --times as the number of loaded modules and splices increases. -- - unload (hscEnv session) (map (\(mod, time) -> LM time mod []) $ moduleEnvToList to_keep) + unload (hscEnv session) (map (\(mod', time') -> LM time' mod' []) $ moduleEnvToList to_keep) return (to_keep, ()) - return (hash <$ hmi, (warns, LinkableResult <$> hmi <*> pure hash)) + return (cfHash <$ hmi, (warns, LinkableResult <$> hmi <*> pure cfHash)) -- | For now we always use bytecode unless something uses unboxed sums and tuples along with TH getLinkableType :: NormalizedFilePath -> Action (Maybe LinkableType) diff --git a/ghcide/src/Development/IDE/Core/Service.hs b/ghcide/src/Development/IDE/Core/Service.hs index e88dd341ab..3efbd7e2d5 100644 --- a/ghcide/src/Development/IDE/Core/Service.hs +++ b/ghcide/src/Development/IDE/Core/Service.hs @@ -52,9 +52,9 @@ data Log instance Pretty Log where pretty = \case - LogShake log -> pretty log - LogOfInterest log -> pretty log - LogFileExists log -> pretty log + LogShake msg -> pretty msg + LogOfInterest msg -> pretty msg + LogFileExists msg -> pretty msg ------------------------------------------------------------ -- Exposed API diff --git a/ghcide/src/Development/IDE/Core/Shake.hs b/ghcide/src/Development/IDE/Core/Shake.hs index 6fee5a6f0d..fb26bbe92e 100644 --- a/ghcide/src/Development/IDE/Core/Shake.hs +++ b/ghcide/src/Development/IDE/Core/Shake.hs @@ -133,7 +133,8 @@ import Development.IDE.GHC.Compat (NameCache, initNameCache, knownKeyNames) import Development.IDE.GHC.Orphans () -import Development.IDE.Graph hiding (ShakeValue) +import Development.IDE.Graph hiding (ShakeValue, + action) import qualified Development.IDE.Graph as Shake import Development.IDE.Graph.Database (ShakeDatabase, shakeGetBuildStep, @@ -144,7 +145,7 @@ import Development.IDE.Graph.Database (ShakeDatabase, import Development.IDE.Graph.Rule import Development.IDE.Types.Action import Development.IDE.Types.Diagnostics -import Development.IDE.Types.Exports +import Development.IDE.Types.Exports hiding (exportsMapSize) import qualified Development.IDE.Types.Exports as ExportsMap import Development.IDE.Types.KnownTargets import Development.IDE.Types.Location @@ -170,7 +171,7 @@ import qualified Language.LSP.Protocol.Types as LSP import qualified Language.LSP.Server as LSP import Language.LSP.VFS hiding (start) import qualified "list-t" ListT -import OpenTelemetry.Eventlog +import OpenTelemetry.Eventlog hiding (addEvent) import qualified StmContainers.Map as STM import System.FilePath hiding (makeRelative) import System.IO.Unsafe (unsafePerformIO) @@ -208,10 +209,10 @@ instance Pretty Log where , "Aborting previous build session took" <+> pretty (showDuration abortDuration) <+> pretty shakeProfilePath ] LogBuildSessionRestartTakingTooLong seconds -> "Build restart is taking too long (" <> pretty seconds <> " seconds)" - LogDelayedAction delayedAction duration -> + LogDelayedAction delayedAct seconds -> hsep - [ "Finished:" <+> pretty (actionName delayedAction) - , "Took:" <+> pretty (showDuration duration) ] + [ "Finished:" <+> pretty (actionName delayedAct) + , "Took:" <+> pretty (showDuration seconds) ] LogBuildSessionFinish e -> vcat [ "Finished build session" @@ -382,9 +383,9 @@ getIdeGlobalExtras ShakeExtras{globals} = do let typ = typeRep (Proxy :: Proxy a) x <- HMap.lookup (typeRep (Proxy :: Proxy a)) <$> readTVarIO globals case x of - Just x - | Just x <- fromDynamic x -> pure x - | otherwise -> errorIO $ "Internal error, getIdeGlobalExtras, wrong type for " ++ show typ ++ " (got " ++ show (dynTypeRep x) ++ ")" + Just y + | Just z <- fromDynamic y -> pure z + | otherwise -> errorIO $ "Internal error, getIdeGlobalExtras, wrong type for " ++ show typ ++ " (got " ++ show (dynTypeRep y) ++ ")" Nothing -> errorIO $ "Internal error, getIdeGlobalExtras, no entry for " ++ show typ getIdeGlobalAction :: forall a . (HasCallStack, IsIdeGlobal a) => Action a @@ -399,8 +400,8 @@ instance IsIdeGlobal GlobalIdeOptions getIdeOptions :: Action IdeOptions getIdeOptions = do GlobalIdeOptions x <- getIdeGlobalAction - env <- lspEnv <$> getShakeExtras - case env of + mbEnv <- lspEnv <$> getShakeExtras + case mbEnv of Nothing -> return x Just env -> do config <- liftIO $ LSP.runLspT env HLS.getClientConfig @@ -432,8 +433,8 @@ lastValueIO s@ShakeExtras{positionMapping,persistentKeys,state} k file = do Nothing -> atomicallyNamed "lastValueIO 1" $ do STM.focus (Focus.alter (alterValue $ Failed True)) (toKey k file) state return Nothing - Just (v,del,ver) -> do - actual_version <- case ver of + Just (v,del,mbVer) -> do + actual_version <- case mbVer of Just ver -> pure (Just $ VFSVersion ver) Nothing -> (Just . ModificationTime <$> getModTime (fromNormalizedFilePath file)) `catch` (\(_ :: IOException) -> pure Nothing) @@ -451,7 +452,7 @@ lastValueIO s@ShakeExtras{positionMapping,persistentKeys,state} k file = do atomicallyNamed "lastValueIO 4" (STM.lookup (toKey k file) state) >>= \case Nothing -> readPersistent - Just (ValueWithDiagnostics v _) -> case v of + Just (ValueWithDiagnostics value _) -> case value of Succeeded ver (fromDynamic -> Just v) -> atomicallyNamed "lastValueIO 5" $ Just . (v,) <$> mappingForVersion positionMapping file ver Stale del ver (fromDynamic -> Just v) -> @@ -602,8 +603,6 @@ shakeOpen recorder lspEnv defaultConfig idePlugins logger debouncer shakeProfileDir (IdeReportProgress reportProgress) ideTesting@(IdeTesting testing) withHieDb indexQueue opts monitoring rules = mdo - let log :: Logger.Priority -> Log -> IO () - log = logWith recorder #if MIN_VERSION_ghc(9,3,0) ideNc <- initNameCache 'r' knownKeyNames @@ -629,10 +628,10 @@ shakeOpen recorder lspEnv defaultConfig idePlugins logger debouncer -- lazily initialize the exports map with the contents of the hiedb -- TODO: exceptions can be swallowed here? _ <- async $ do - log Debug LogCreateHieDbExportsMapStart + logWith recorder Debug LogCreateHieDbExportsMapStart em <- createExportsMapHieDb withHieDb atomically $ modifyTVar' exportsMap (<> em) - log Debug $ LogCreateHieDbExportsMapFinish (ExportsMap.size em) + logWith recorder Debug $ LogCreateHieDbExportsMapFinish (ExportsMap.size em) progress <- do let (before, after) = if testing then (0,0.1) else (0.1,0.1) @@ -735,14 +734,13 @@ shakeRestart recorder IdeState{..} vfs reason acts = withMVar' shakeSession (\runner -> do - let log = logWith recorder - (stopTime,()) <- duration $ logErrorAfter 10 recorder $ cancelShakeSession runner + (stopTime,()) <- duration $ logErrorAfter 10 $ cancelShakeSession runner res <- shakeDatabaseProfile shakeDb backlog <- readTVarIO $ dirtyKeys shakeExtras queue <- atomicallyNamed "actionQueue - peek" $ peekInProgress $ actionQueue shakeExtras -- this log is required by tests - log Debug $ LogBuildSessionRestart reason queue backlog stopTime res + logWith recorder Debug $ LogBuildSessionRestart reason queue backlog stopTime res ) -- It is crucial to be masked here, otherwise we can get killed -- between spawning the new thread and updating shakeSession. @@ -750,8 +748,8 @@ shakeRestart recorder IdeState{..} vfs reason acts = (\() -> do (,()) <$> newSession recorder shakeExtras vfs shakeDb acts reason) where - logErrorAfter :: Seconds -> Recorder (WithPriority Log) -> IO () -> IO () - logErrorAfter seconds recorder action = flip withAsync (const action) $ do + logErrorAfter :: Seconds -> IO () -> IO () + logErrorAfter seconds action = flip withAsync (const action) $ do sleep seconds logWith recorder Error (LogBuildSessionRestartTakingTooLong seconds) @@ -764,8 +762,8 @@ shakeEnqueue :: ShakeExtras -> DelayedAction a -> IO (IO a) shakeEnqueue ShakeExtras{actionQueue, logger} act = do (b, dai) <- instantiateDelayedAction act atomicallyNamed "actionQueue - push" $ pushQueue dai actionQueue - let wait' b = - waitBarrier b `catches` + let wait' barrier = + waitBarrier barrier `catches` [ Handler(\BlockedIndefinitelyOnMVar -> fail $ "internal bug: forever blocked on MVar for " <> actionName act) @@ -1032,7 +1030,7 @@ useWithStaleFast' key file = do -- Async trigger the key to be built anyway because we want to -- keep updating the value in the key. - wait <- delayedAction $ mkDelayedAction ("C:" ++ show key ++ ":" ++ fromNormalizedFilePath file) Debug $ use key file + waitValue <- delayedAction $ mkDelayedAction ("C:" ++ show key ++ ":" ++ fromNormalizedFilePath file) Debug $ use key file s@ShakeExtras{state} <- askShake r <- liftIO $ atomicallyNamed "useStateFast" $ getValues state key file @@ -1043,13 +1041,13 @@ useWithStaleFast' key file = do res <- lastValueIO s key file case res of Nothing -> do - a <- wait + a <- waitValue pure $ FastResult ((,zeroMapping) <$> a) (pure a) - Just _ -> pure $ FastResult res wait + Just _ -> pure $ FastResult res waitValue -- Otherwise, use the computed value even if it's out of date. Just _ -> do res <- lastValueIO s key file - pure $ FastResult res wait + pure $ FastResult res waitValue useNoFile :: IdeRule k v => k -> Action (Maybe v) useNoFile key = use key emptyFilePath @@ -1147,7 +1145,7 @@ defineNoFile recorder f = defineNoDiagnostics recorder $ \k file -> do defineEarlyCutOffNoFile :: IdeRule k v => Recorder (WithPriority Log) -> (k -> Action (BS.ByteString, v)) -> Rules () defineEarlyCutOffNoFile recorder f = defineEarlyCutoff recorder $ RuleNoDiagnostics $ \k file -> do - if file == emptyFilePath then do (hash, res) <- f k; return (Just hash, Just res) else + if file == emptyFilePath then do (hashString, res) <- f k; return (Just hashString, Just res) else fail $ "Rule " ++ show k ++ " should always be called with the empty string for a file" defineEarlyCutoff' @@ -1161,14 +1159,14 @@ defineEarlyCutoff' -> RunMode -> (Value v -> Action (Maybe BS.ByteString, IdeResult v)) -> Action (RunResult (A (RuleResult k))) -defineEarlyCutoff' doDiagnostics cmp key file old mode action = do +defineEarlyCutoff' doDiagnostics cmp key file mbOld mode action = do ShakeExtras{state, progress, dirtyKeys} <- getShakeExtras options <- getIdeOptions (if optSkipProgress options key then id else inProgress progress file) $ do - val <- case old of + val <- case mbOld of Just old | mode == RunDependenciesSame -> do - v <- liftIO $ atomicallyNamed "define - read 1" $ getValues state key file - case v of + mbValue <- liftIO $ atomicallyNamed "define - read 1" $ getValues state key file + case mbValue of -- No changes in the dependencies and we have -- an existing successful result. Just (v@(Succeeded _ x), diags) -> do @@ -1188,19 +1186,19 @@ defineEarlyCutoff' doDiagnostics cmp key file old mode action = do Just (Succeeded ver v, _) -> Stale Nothing ver v Just (Stale d ver v, _) -> Stale d ver v Just (Failed b, _) -> Failed b - (bs, (diags, res)) <- actionCatch + (mbBs, (diags, mbRes)) <- actionCatch (do v <- action staleV; liftIO $ evaluate $ force v) $ \(e :: SomeException) -> do pure (Nothing, ([ideErrorText file $ T.pack $ show e | not $ isBadDependency e],Nothing)) - ver <- estimateFileVersionUnsafely key res file - (bs, res) <- case res of + ver <- estimateFileVersionUnsafely key mbRes file + (bs, res) <- case mbRes of Nothing -> do - pure (toShakeValue ShakeStale bs, staleV) - Just v -> pure (maybe ShakeNoCutoff ShakeResult bs, Succeeded ver v) + pure (toShakeValue ShakeStale mbBs, staleV) + Just v -> pure (maybe ShakeNoCutoff ShakeResult mbBs, Succeeded ver v) liftIO $ atomicallyNamed "define - write" $ setValues state key file res (Vector.fromList diags) doDiagnostics (vfsVersion =<< ver) diags - let eq = case (bs, fmap decodeShakeValue old) of + let eq = case (bs, fmap decodeShakeValue mbOld) of (ShakeResult a, Just (ShakeResult b)) -> cmp a b (ShakeStale a, Just (ShakeStale b)) -> cmp a b -- If we do not have a previous result @@ -1217,9 +1215,7 @@ defineEarlyCutoff' doDiagnostics cmp key file old mode action = do -- without creating a dependency on the GetModificationTime rule -- (and without creating cycles in the build graph). estimateFileVersionUnsafely - :: forall k v - . IdeRule k v - => k + :: k -> Maybe v -> NormalizedFilePath -> Action (Maybe FileVersion) @@ -1257,7 +1253,7 @@ updateFileDiagnostics recorder fp ver k ShakeExtras{diagnostics, hiddenDiagnosti addTagUnsafe :: String -> String -> String -> a -> a addTagUnsafe msg t x v = unsafePerformIO(addTag (msg <> t) x) `seq` v update :: (forall a. String -> String -> a -> a) -> [Diagnostic] -> STMDiagnosticStore -> STM [Diagnostic] - update addTagUnsafe new store = addTagUnsafe "count" (show $ Prelude.length new) $ setStageDiagnostics addTagUnsafe uri ver (renderKey k) new store + update addTagUnsafeMethod new store = addTagUnsafeMethod "count" (show $ Prelude.length new) $ setStageDiagnostics addTagUnsafeMethod uri ver (renderKey k) new store current = second diagsFromRule <$> current0 addTag "version" (show ver) mask_ $ do @@ -1267,11 +1263,11 @@ updateFileDiagnostics recorder fp ver k ShakeExtras{diagnostics, hiddenDiagnosti -- publishDiagnosticsNotification. newDiags <- liftIO $ atomicallyNamed "diagnostics - update" $ update (addTagUnsafe "shown ") (map snd currentShown) diagnostics _ <- liftIO $ atomicallyNamed "diagnostics - hidden" $ update (addTagUnsafe "hidden ") (map snd currentHidden) hiddenDiagnostics - let uri = filePathToUri' fp + let uri' = filePathToUri' fp let delay = if null newDiags then 0.1 else 0 - registerEvent debouncer delay uri $ withTrace ("report diagnostics " <> fromString (fromNormalizedFilePath fp)) $ \tag -> do + registerEvent debouncer delay uri' $ withTrace ("report diagnostics " <> fromString (fromNormalizedFilePath fp)) $ \tag -> do join $ mask_ $ do - lastPublish <- atomicallyNamed "diagnostics - publish" $ STM.focus (Focus.lookupWithDefault [] <* Focus.insert newDiags) uri publishedDiagnostics + lastPublish <- atomicallyNamed "diagnostics - publish" $ STM.focus (Focus.lookupWithDefault [] <* Focus.insert newDiags) uri' publishedDiagnostics let action = when (lastPublish /= newDiags) $ case lspEnv of Nothing -> -- Print an LSP event. logWith recorder Info $ LogDiagsDiffButNoLspEnv (map (fp, ShowDiag,) newDiags) @@ -1279,7 +1275,7 @@ updateFileDiagnostics recorder fp ver k ShakeExtras{diagnostics, hiddenDiagnosti liftIO $ tag "count" (show $ Prelude.length newDiags) liftIO $ tag "key" (show k) LSP.sendNotification SMethod_TextDocumentPublishDiagnostics $ - LSP.PublishDiagnosticsParams (fromNormalizedUri uri) (fmap fromIntegral ver) ( newDiags) + LSP.PublishDiagnosticsParams (fromNormalizedUri uri') (fmap fromIntegral ver) ( newDiags) return action where diagsFromRule :: Diagnostic -> Diagnostic diff --git a/ghcide/src/Development/IDE/GHC/CPP.hs b/ghcide/src/Development/IDE/GHC/CPP.hs index 930cd7f723..00d6303134 100644 --- a/ghcide/src/Development/IDE/GHC/CPP.hs +++ b/ghcide/src/Development/IDE/GHC/CPP.hs @@ -47,7 +47,7 @@ addOptP f = alterToolSettings $ \s -> s } where fingerprintStrings ss = fingerprintFingerprints $ map fingerprintString ss - alterToolSettings f dynFlags = dynFlags { toolSettings = f (toolSettings dynFlags) } + alterToolSettings g dynFlags = dynFlags { toolSettings = g (toolSettings dynFlags) } doCpp :: HscEnv -> FilePath -> FilePath -> IO () doCpp env input_fn output_fn = diff --git a/ghcide/src/Development/IDE/GHC/Compat.hs b/ghcide/src/Development/IDE/GHC/Compat.hs index af2f3ce69e..ca4ab8d1d2 100644 --- a/ghcide/src/Development/IDE/GHC/Compat.hs +++ b/ghcide/src/Development/IDE/GHC/Compat.hs @@ -413,9 +413,9 @@ simplifyExpr _ = GHC.simplifyExpr corePrepExpr :: DynFlags -> HscEnv -> CoreExpr -> IO CoreExpr #if MIN_VERSION_ghc(9,5,0) -corePrepExpr _ env exp = do +corePrepExpr _ env expr = do cfg <- initCorePrepConfig env - GHC.corePrepExpr (Development.IDE.GHC.Compat.Env.hsc_logger env) cfg exp + GHC.corePrepExpr (Development.IDE.GHC.Compat.Env.hsc_logger env) cfg expr #else corePrepExpr _ = GHC.corePrepExpr #endif @@ -569,12 +569,12 @@ combineNodeInfo' :: Ord a => NodeInfo a -> NodeInfo a -> NodeInfo a NodeInfo (S.union as bs) (mergeSorted ai bi) (Map.unionWith (<>) ad bd) where mergeSorted :: Ord a => [a] -> [a] -> [a] - mergeSorted la@(a:as) lb@(b:bs) = case compare a b of - LT -> a : mergeSorted as lb - EQ -> a : mergeSorted as bs - GT -> b : mergeSorted la bs - mergeSorted as [] = as - mergeSorted [] bs = bs + mergeSorted la@(a:axs) lb@(b:bxs) = case compare a b of + LT -> a : mergeSorted axs lb + EQ -> a : mergeSorted axs bxs + GT -> b : mergeSorted la bxs + mergeSorted axs [] = axs + mergeSorted [] bxs = bxs #else diff --git a/ghcide/src/Development/IDE/GHC/Compat/Env.hs b/ghcide/src/Development/IDE/GHC/Compat/Env.hs index 86df19b6ae..644b417e65 100644 --- a/ghcide/src/Development/IDE/GHC/Compat/Env.hs +++ b/ghcide/src/Development/IDE/GHC/Compat/Env.hs @@ -64,7 +64,7 @@ import Module #if MIN_VERSION_ghc(9,0,0) import GHC.Driver.Hooks (Hooks) -import GHC.Driver.Session hiding (mkHomeModule) +import GHC.Driver.Session hiding (mkHomeModule, ways) import GHC.Unit.Types (Module, UnitId) #endif diff --git a/ghcide/src/Development/IDE/GHC/Compat/Units.hs b/ghcide/src/Development/IDE/GHC/Compat/Units.hs index a39f225e4f..dcd50db093 100644 --- a/ghcide/src/Development/IDE/GHC/Compat/Units.hs +++ b/ghcide/src/Development/IDE/GHC/Compat/Units.hs @@ -58,6 +58,7 @@ import Data.Version import Development.IDE.GHC.Compat.Core import Development.IDE.GHC.Compat.Env import Development.IDE.GHC.Compat.Outputable +import Prelude hiding (mod) #if !MIN_VERSION_ghc(9,0,0) import qualified DynFlags diff --git a/ghcide/src/Development/IDE/GHC/CoreFile.hs b/ghcide/src/Development/IDE/GHC/CoreFile.hs index 12d888b179..efab2b17b1 100644 --- a/ghcide/src/Development/IDE/GHC/CoreFile.hs +++ b/ghcide/src/Development/IDE/GHC/CoreFile.hs @@ -23,6 +23,7 @@ import qualified Data.Text as T import Development.IDE.GHC.Compat import qualified Development.IDE.GHC.Compat.Util as Util import GHC.Fingerprint +import Prelude hiding (mod) #if !MIN_VERSION_ghc(9,0,0) import Binary @@ -166,14 +167,14 @@ getClassImplicitBinds cls | (op, val_index) <- classAllSelIds cls `zip` [0..] ] get_defn :: Id -> CoreBind -get_defn id = NonRec id (unfoldingTemplate (realIdUnfolding id)) +get_defn identifier = NonRec identifier (unfoldingTemplate (realIdUnfolding identifier)) toIfaceTopBndr1 :: Module -> Id -> IfaceId -toIfaceTopBndr1 mod id - = IfaceId (mangleDeclName mod $ getName id) - (toIfaceType (idType id)) - (toIfaceIdDetails (idDetails id)) - (toIfaceIdInfo (idInfo id)) +toIfaceTopBndr1 mod identifier + = IfaceId (mangleDeclName mod $ getName identifier) + (toIfaceType (idType identifier)) + (toIfaceIdDetails (idDetails identifier)) + (toIfaceIdInfo (idInfo identifier)) toIfaceTopBind1 :: Module -> Bind Id -> TopIfaceBinding IfaceId toIfaceTopBind1 mod (NonRec b r) = TopIfaceNonRec (toIfaceTopBndr1 mod b) (toIfaceExpr r) @@ -223,8 +224,8 @@ tcIfaceId = fmap getIfaceId . tcIfaceDecl False <=< unmangle_decl_name pure $ ifid{ ifName = name' } | otherwise = pure ifid -- invariant: 'IfaceId' is always a 'IfaceId' constructor - getIfaceId (AnId id) = id - getIfaceId _ = error "tcIfaceId: got non Id" + getIfaceId (AnId identifier) = identifier + getIfaceId _ = error "tcIfaceId: got non Id" tc_iface_bindings :: TopIfaceBinding Id -> IfL CoreBind tc_iface_bindings (TopIfaceNonRec v e) = do diff --git a/ghcide/src/Development/IDE/GHC/Error.hs b/ghcide/src/Development/IDE/GHC/Error.hs index a8f5e88ca3..8b5c9edc29 100644 --- a/ghcide/src/Development/IDE/GHC/Error.hs +++ b/ghcide/src/Development/IDE/GHC/Error.hs @@ -175,12 +175,12 @@ realSpan = \case -- diagnostics catchSrcErrors :: DynFlags -> T.Text -> IO a -> IO (Either [FileDiagnostic] a) catchSrcErrors dflags fromWhere ghcM = do - Compat.handleGhcException (ghcExceptionToDiagnostics dflags) $ - handleSourceError (sourceErrorToDiagnostics dflags) $ + Compat.handleGhcException ghcExceptionToDiagnostics $ + handleSourceError sourceErrorToDiagnostics $ Right <$> ghcM where - ghcExceptionToDiagnostics dflags = return . Left . diagFromGhcException fromWhere dflags - sourceErrorToDiagnostics dflags = return . Left . diagFromErrMsgs fromWhere dflags + ghcExceptionToDiagnostics = return . Left . diagFromGhcException fromWhere dflags + sourceErrorToDiagnostics = return . Left . diagFromErrMsgs fromWhere dflags #if MIN_VERSION_ghc(9,3,0) . fmap (fmap Compat.renderDiagnosticMessageWithHints) . Compat.getMessages #endif diff --git a/ghcide/src/Development/IDE/GHC/Util.hs b/ghcide/src/Development/IDE/GHC/Util.hs index 3a5be4582a..d158f139fb 100644 --- a/ghcide/src/Development/IDE/GHC/Util.hs +++ b/ghcide/src/Development/IDE/GHC/Util.hs @@ -44,14 +44,15 @@ import qualified Data.Text as T import qualified Data.Text.Encoding as T import qualified Data.Text.Encoding.Error as T import Data.Typeable -import Development.IDE.GHC.Compat as GHC +import Development.IDE.GHC.Compat as GHC hiding (unitState) import qualified Development.IDE.GHC.Compat.Parser as Compat import qualified Development.IDE.GHC.Compat.Units as Compat import Development.IDE.Types.Location import Foreign.ForeignPtr import Foreign.Ptr import Foreign.Storable -import GHC hiding (ParsedModule (..)) +import GHC hiding (ParsedModule (..), + parser) import GHC.IO.BufferedIO (BufferedIO) import GHC.IO.Device as IODevice import GHC.IO.Encoding @@ -170,9 +171,9 @@ cgGutsToCoreModule safeMode guts modDetails = CoreModule -- Will produce an 8 byte unreadable ByteString. fingerprintToBS :: Fingerprint -> BS.ByteString fingerprintToBS (Fingerprint a b) = BS.unsafeCreate 8 $ \ptr -> do - ptr <- pure $ castPtr ptr - pokeElemOff ptr 0 a - pokeElemOff ptr 1 b + ptr' <- pure $ castPtr ptr + pokeElemOff ptr' 0 a + pokeElemOff ptr' 1 b -- | Take the 'Fingerprint' of a 'StringBuffer'. fingerprintFromStringBuffer :: StringBuffer -> IO Fingerprint diff --git a/ghcide/src/Development/IDE/Import/DependencyInformation.hs b/ghcide/src/Development/IDE/Import/DependencyInformation.hs index d255c3ac1e..03363c4570 100644 --- a/ghcide/src/Development/IDE/Import/DependencyInformation.hs +++ b/ghcide/src/Development/IDE/Import/DependencyInformation.hs @@ -33,7 +33,7 @@ import Control.DeepSeq import Data.Bifunctor import Data.Coerce import Data.Either -import Data.Graph +import Data.Graph hiding (edges, path) import Data.HashMap.Strict (HashMap) import qualified Data.HashMap.Strict as HMS import Data.IntMap (IntMap) @@ -48,13 +48,14 @@ import Data.Maybe import Data.Tuple.Extra hiding (first, second) import Development.IDE.GHC.Orphans () import GHC.Generics (Generic) +import Prelude hiding (mod) import Development.IDE.Import.FindImports (ArtifactsLocation (..)) import Development.IDE.Types.Diagnostics import Development.IDE.Types.Location +import Development.IDE.GHC.Compat import GHC -import Development.IDE.GHC.Compat -- | The imports for a given module. newtype ModuleImports = ModuleImports @@ -92,14 +93,14 @@ getPathId path m@PathIdMap{..} = case HMS.lookup (artifactFilePath path) pathToIdMap of Nothing -> let !newId = FilePathId nextFreshId - in (newId, insertPathId path newId m) - Just id -> (id, m) + in (newId, insertPathId newId ) + Just fileId -> (fileId, m) where - insertPathId :: ArtifactsLocation -> FilePathId -> PathIdMap -> PathIdMap - insertPathId path id PathIdMap{..} = + insertPathId :: FilePathId -> PathIdMap + insertPathId fileId = PathIdMap - (IntMap.insert (getFilePathId id) path idToPathMap) - (HMS.insert (artifactFilePath path) id pathToIdMap) + (IntMap.insert (getFilePathId fileId) path idToPathMap) + (HMS.insert (artifactFilePath path) fileId pathToIdMap) (succ nextFreshId) insertImport :: FilePathId -> Either ModuleParseError ModuleImports -> RawDependencyInformation -> RawDependencyInformation @@ -115,7 +116,7 @@ idToPath :: PathIdMap -> FilePathId -> NormalizedFilePath idToPath pathIdMap filePathId = artifactFilePath $ idToModLocation pathIdMap filePathId idToModLocation :: PathIdMap -> FilePathId -> ArtifactsLocation -idToModLocation PathIdMap{idToPathMap} (FilePathId id) = idToPathMap IntMap.! id +idToModLocation PathIdMap{idToPathMap} (FilePathId i) = idToPathMap IntMap.! i type BootIdMap = FilePathIdMap FilePathId @@ -137,7 +138,7 @@ data DependencyInformation = DependencyInformation { depErrorNodes :: !(FilePathIdMap (NonEmpty NodeError)) -- ^ Nodes that cannot be processed correctly. - , depModules :: !(FilePathIdMap ShowableModule) + , depModules :: !(FilePathIdMap ShowableModule) , depModuleDeps :: !(FilePathIdMap FilePathIdSet) -- ^ For a non-error node, this contains the set of module immediate dependencies -- in the same package. @@ -273,9 +274,9 @@ buildResultGraph g = propagatedErrors errorsForCycle files = IntMap.fromListWith (<>) $ coerce $ concatMap (cycleErrorsForFile files) files cycleErrorsForFile :: [FilePathId] -> FilePathId -> [(FilePathId,NodeResult)] - cycleErrorsForFile cycle f = - let entryPoints = mapMaybe (findImport f) cycle - in map (\imp -> (f, ErrorNode (PartOfCycle imp cycle :| []))) entryPoints + cycleErrorsForFile cycles' f = + let entryPoints = mapMaybe (findImport f) cycles' + in map (\imp -> (f, ErrorNode (PartOfCycle imp cycles' :| []))) entryPoints otherErrors = IntMap.map otherErrorsForFile g otherErrorsForFile :: Either ModuleParseError ModuleImports -> NodeResult otherErrorsForFile (Left err) = ErrorNode (ParseError err :| []) diff --git a/ghcide/src/Development/IDE/Import/FindImports.hs b/ghcide/src/Development/IDE/Import/FindImports.hs index 490dde5c78..d3a6cb645b 100644 --- a/ghcide/src/Development/IDE/Import/FindImports.hs +++ b/ghcide/src/Development/IDE/Import/FindImports.hs @@ -59,14 +59,14 @@ instance NFData Import where rnf PackageImport = () modSummaryToArtifactsLocation :: NormalizedFilePath -> Maybe ModSummary -> ArtifactsLocation -modSummaryToArtifactsLocation nfp ms = ArtifactsLocation nfp (ms_location <$> ms) source mod +modSummaryToArtifactsLocation nfp ms = ArtifactsLocation nfp (ms_location <$> ms) source mbMod where isSource HsSrcFile = True isSource _ = False source = case ms of - Nothing -> "-boot" `isSuffixOf` fromNormalizedFilePath nfp - Just ms -> isSource (ms_hsc_src ms) - mod = ms_mod <$> ms + Nothing -> "-boot" `isSuffixOf` fromNormalizedFilePath nfp + Just modSum -> isSource (ms_hsc_src modSum) + mbMod = ms_mod <$> ms -- | locate a module in the file system. Where we go from *daml to Haskell locateModuleFile :: MonadIO m @@ -134,7 +134,7 @@ locateModule env comp_info exts targetFor modName mbPkgName isSource = do | Just (uid, dirs) <- lookup (PackageName pkgName) import_paths -> lookupLocal uid dirs #endif - | otherwise -> lookupInPackageDB env + | otherwise -> lookupInPackageDB #if MIN_VERSION_ghc(9,3,0) NoPkgQual -> do #else @@ -143,7 +143,7 @@ locateModule env comp_info exts targetFor modName mbPkgName isSource = do mbFile <- locateModuleFile ((homeUnitId_ dflags, importPaths dflags) : other_imports) exts targetFor isSource $ unLoc modName case mbFile of - Nothing -> lookupInPackageDB env + Nothing -> lookupInPackageDB Just (uid, file) -> toModLocation uid file where dflags = hsc_dflags env @@ -182,19 +182,19 @@ locateModule env comp_info exts targetFor modName mbPkgName isSource = do toModLocation uid file = liftIO $ do loc <- mkHomeModLocation dflags (unLoc modName) (fromNormalizedFilePath file) #if MIN_VERSION_ghc(9,0,0) - let mod = mkModule (RealUnit $ Definite uid) (unLoc modName) -- TODO support backpack holes + let genMod = mkModule (RealUnit $ Definite uid) (unLoc modName) -- TODO support backpack holes #else - let mod = mkModule uid (unLoc modName) + let genMod = mkModule uid (unLoc modName) #endif - return $ Right $ FileImport $ ArtifactsLocation file (Just loc) (not isSource) (Just mod) + return $ Right $ FileImport $ ArtifactsLocation file (Just loc) (not isSource) (Just genMod) lookupLocal uid dirs = do mbFile <- locateModuleFile [(uid, dirs)] exts targetFor isSource $ unLoc modName case mbFile of Nothing -> return $ Left $ notFoundErr env modName $ LookupNotFound [] - Just (uid, file) -> toModLocation uid file + Just (uid', file) -> toModLocation uid' file - lookupInPackageDB env = do + lookupInPackageDB = do case Compat.lookupModuleWithSuggestions env (unLoc modName) mbPkgName of LookupFound _m _pkgConfig -> return $ Right PackageImport reason -> return $ Left $ notFoundErr env modName reason diff --git a/ghcide/src/Development/IDE/LSP/LanguageServer.hs b/ghcide/src/Development/IDE/LSP/LanguageServer.hs index d20f85adc1..51ed44f17f 100644 --- a/ghcide/src/Development/IDE/LSP/LanguageServer.hs +++ b/ghcide/src/Development/IDE/LSP/LanguageServer.hs @@ -43,7 +43,6 @@ import Development.IDE.Core.Tracing import qualified Development.IDE.Session as Session import Development.IDE.Types.Shake (WithHieDb) import Ide.Logger -import qualified Ide.Logger as Logger import Language.LSP.Server (LanguageContextEnv, LspServerLog, type (<~>)) @@ -77,8 +76,8 @@ instance Pretty Log where "Reactor thread stopped" LogCancelledRequest requestId -> "Cancelled request" <+> viaShow requestId - LogSession log -> pretty log - LogLspServer log -> pretty log + LogSession msg -> pretty msg + LogLspServer msg -> pretty msg -- used to smuggle RankNType WithHieDb through dbMVar newtype WithHieDbShield = WithHieDbShield WithHieDb @@ -211,16 +210,16 @@ handleInit recorder getHieDbLoc getIdeState lifetime exitClientMsg clearReqId wa let initConfig = parseConfiguration params - log Info $ LogRegisteringIdeConfig initConfig + logWith recorder Info $ LogRegisteringIdeConfig initConfig registerIdeConfiguration (shakeExtras ide) initConfig let handleServerException (Left e) = do - log Error $ LogReactorThreadException e + logWith recorder Error $ LogReactorThreadException e exitClientMsg handleServerException (Right _) = pure () exceptionInHandler e = do - log Error $ LogReactorMessageActionException e + logWith recorder Error $ LogReactorMessageActionException e checkCancelled _id act k = flip finally (clearReqId _id) $ @@ -232,15 +231,15 @@ handleInit recorder getHieDbLoc getIdeState lifetime exitClientMsg clearReqId wa cancelOrRes <- race (waitForCancel _id) act case cancelOrRes of Left () -> do - log Debug $ LogCancelledRequest _id + logWith recorder Debug $ LogCancelledRequest _id k $ ResponseError (InL LSPErrorCodes_RequestCancelled) "" Nothing Right res -> pure res ) $ \(e :: SomeException) -> do exceptionInHandler e k $ ResponseError (InR ErrorCodes_InternalError) (T.pack $ show e) Nothing _ <- flip forkFinally handleServerException $ do - untilMVar lifetime $ runWithDb (cmapWithPrio LogSession recorder) dbLoc $ \withHieDb hieChan -> do - putMVar dbMVar (WithHieDbShield withHieDb,hieChan) + untilMVar lifetime $ runWithDb (cmapWithPrio LogSession recorder) dbLoc $ \withHieDb' hieChan' -> do + putMVar dbMVar (WithHieDbShield withHieDb',hieChan') forever $ do msg <- readChan clientMsgChan -- We dispatch notifications synchronously and requests asynchronously @@ -248,13 +247,9 @@ handleInit recorder getHieDbLoc getIdeState lifetime exitClientMsg clearReqId wa case msg of ReactorNotification act -> handle exceptionInHandler act ReactorRequest _id act k -> void $ async $ checkCancelled _id act k - log Info LogReactorThreadStopped + logWith recorder Info LogReactorThreadStopped pure $ Right (env,ide) - where - log :: Logger.Priority -> Log -> IO () - log = logWith recorder - -- | Runs the action until it ends or until the given MVar is put. -- Rethrows any exceptions. diff --git a/ghcide/src/Development/IDE/LSP/Notifications.hs b/ghcide/src/Development/IDE/LSP/Notifications.hs index 6674bd4b86..16301e57f7 100644 --- a/ghcide/src/Development/IDE/LSP/Notifications.hs +++ b/ghcide/src/Development/IDE/LSP/Notifications.hs @@ -49,8 +49,8 @@ data Log instance Pretty Log where pretty = \case - LogShake log -> pretty log - LogFileStore log -> pretty log + LogShake msg -> pretty msg + LogFileStore msg -> pretty msg whenUriFile :: Uri -> (NormalizedFilePath -> IO ()) -> IO () whenUriFile uri act = whenJust (LSP.uriToFilePath uri) $ act . toNormalizedFilePath' diff --git a/ghcide/src/Development/IDE/LSP/Outline.hs b/ghcide/src/Development/IDE/LSP/Outline.hs index e72296a5bb..fd9c45c8cf 100644 --- a/ghcide/src/Development/IDE/LSP/Outline.hs +++ b/ghcide/src/Development/IDE/LSP/Outline.hs @@ -93,13 +93,13 @@ documentSymbolForDecl (L (locA -> (RealSrcSpan l _)) (TyClD _ ClassDecl { tcdLNa , _detail = Just "class" , _children = Just $ - [ (defDocumentSymbol l :: DocumentSymbol) + [ (defDocumentSymbol l' :: DocumentSymbol) { _name = printOutputable n , _kind = SymbolKind_Method - , _selectionRange = realSrcSpanToRange l' + , _selectionRange = realSrcSpanToRange l'' } - | L (locA -> (RealSrcSpan l _)) (ClassOpSig _ False names _) <- tcdSigs - , L (locA -> (RealSrcSpan l' _)) n <- names + | L (locA -> (RealSrcSpan l' _)) (ClassOpSig _ False names _) <- tcdSigs + , L (locA -> (RealSrcSpan l'' _)) n <- names ] } documentSymbolForDecl (L (locA -> (RealSrcSpan l _)) (TyClD _ DataDecl { tcdLName = L _ name, tcdDataDefn = HsDataDefn { dd_cons } })) @@ -108,7 +108,7 @@ documentSymbolForDecl (L (locA -> (RealSrcSpan l _)) (TyClD _ DataDecl { tcdLNam , _kind = SymbolKind_Struct , _children = Just $ - [ (defDocumentSymbol l :: DocumentSymbol) + [ (defDocumentSymbol l'' :: DocumentSymbol) { _name = printOutputable n , _kind = SymbolKind_Constructor , _selectionRange = realSrcSpanToRange l' @@ -119,17 +119,17 @@ documentSymbolForDecl (L (locA -> (RealSrcSpan l _)) (TyClD _ DataDecl { tcdLNam , let (cs, flds) = hsConDeclsBinders con , let childs = mapMaybe cvtFld flds , L (locA -> RealSrcSpan l' _) n <- cs - , let l = case con of - L (locA -> RealSrcSpan l _) _ -> l + , let l'' = case con of + L (locA -> RealSrcSpan l''' _) _ -> l''' _ -> l' ] } where cvtFld :: LFieldOcc GhcPs -> Maybe DocumentSymbol #if MIN_VERSION_ghc(9,3,0) - cvtFld (L (locA -> RealSrcSpan l _) n) = Just $ (defDocumentSymbol l :: DocumentSymbol) + cvtFld (L (locA -> RealSrcSpan l' _) n) = Just $ (defDocumentSymbol l' :: DocumentSymbol) #else - cvtFld (L (RealSrcSpan l _) n) = Just $ (defDocumentSymbol l :: DocumentSymbol) + cvtFld (L (RealSrcSpan l' _) n) = Just $ (defDocumentSymbol l' :: DocumentSymbol) #endif #if MIN_VERSION_ghc(9,3,0) { _name = printOutputable (unLoc (foLabel n)) diff --git a/ghcide/src/Development/IDE/Main.hs b/ghcide/src/Development/IDE/Main.hs index 2036193acb..b1eb16a8fe 100644 --- a/ghcide/src/Development/IDE/Main.hs +++ b/ghcide/src/Development/IDE/Main.hs @@ -145,7 +145,7 @@ data Log instance Pretty Log where pretty = \case - LogHeapStats log -> pretty log + LogHeapStats msg -> pretty msg LogLspStart pluginIds -> nest 2 $ vsep [ "Starting LSP server..." @@ -158,13 +158,13 @@ instance Pretty Log where "shouldRunSubset:" <+> pretty shouldRunSubset LogSetInitialDynFlagsException e -> "setInitialDynFlags:" <+> pretty (displayException e) - LogService log -> pretty log - LogShake log -> pretty log - LogGhcIde log -> pretty log - LogLanguageServer log -> pretty log - LogSession log -> pretty log - LogPluginHLS log -> pretty log - LogRules log -> pretty log + LogService msg -> pretty msg + LogShake msg -> pretty msg + LogGhcIde msg -> pretty msg + LogLanguageServer msg -> pretty msg + LogSession msg -> pretty msg + LogPluginHLS msg -> pretty msg + LogRules msg -> pretty msg data Command = Check [FilePath] -- ^ Typecheck some paths and print diagnostics. Exit code is the number of failures @@ -279,9 +279,6 @@ testing recorder logger plugins = defaultMain :: Recorder (WithPriority Log) -> Arguments -> IO () defaultMain recorder Arguments{..} = withHeapStats (cmapWithPrio LogHeapStats recorder) fun where - log :: Priority -> Log -> IO () - log = logWith recorder - fun = do setLocaleEncoding utf8 pid <- T.pack . show <$> getProcessID @@ -304,14 +301,14 @@ defaultMain recorder Arguments{..} = withHeapStats (cmapWithPrio LogHeapStats re case argCommand of LSP -> withNumCapabilities numCapabilities $ do - t <- offsetTime - log Info $ LogLspStart (pluginId <$> ipMap argsHlsPlugins) + ioT <- offsetTime + logWith recorder Info $ LogLspStart (pluginId <$> ipMap argsHlsPlugins) let getIdeState :: LSP.LanguageContextEnv Config -> Maybe FilePath -> WithHieDb -> IndexQueue -> IO IdeState getIdeState env rootPath withHieDb hieChan = do traverse_ IO.setCurrentDirectory rootPath - t <- t - log Info $ LogLspStartDuration t + t <- ioT + logWith recorder Info $ LogLspStartDuration t dir <- maybe IO.getCurrentDirectory return rootPath @@ -320,7 +317,7 @@ defaultMain recorder Arguments{..} = withHeapStats (cmapWithPrio LogHeapStats re _mlibdir <- setInitialDynFlags (cmapWithPrio LogSession recorder) dir argsSessionLoadingOptions -- TODO: should probably catch/log/rethrow at top level instead - `catchAny` (\e -> log Error (LogSetInitialDynFlagsException e) >> pure Nothing) + `catchAny` (\e -> logWith recorder Error (LogSetInitialDynFlagsException e) >> pure Nothing) sessionLoader <- loadSessionWithOptions (cmapWithPrio LogSession recorder) argsSessionLoadingOptions dir config <- LSP.runLspT env LSP.getConfig @@ -328,9 +325,9 @@ defaultMain recorder Arguments{..} = withHeapStats (cmapWithPrio LogHeapStats re -- disable runSubset if the client doesn't support watched files runSubset <- (optRunSubset def_options &&) <$> LSP.runLspT env isWatchSupported - log Debug $ LogShouldRunSubset runSubset + logWith recorder Debug $ LogShouldRunSubset runSubset - let options = def_options + let ideOptions = def_options { optReportProgress = clientSupportsProgress caps , optModifyDynFlags = optModifyDynFlags def_options <> pluginModifyDynflags plugins , optRunSubset = runSubset @@ -345,7 +342,7 @@ defaultMain recorder Arguments{..} = withHeapStats (cmapWithPrio LogHeapStats re (Just env) logger debouncer - options + ideOptions withHieDb hieChan monitoring @@ -368,11 +365,11 @@ defaultMain recorder Arguments{..} = withHeapStats (cmapWithPrio LogHeapStats re putStrLn $ "\nStep 1/4: Finding files to test in " ++ dir files <- expandFiles (argFiles ++ ["." | null argFiles]) -- LSP works with absolute file paths, so try and behave similarly - files <- nubOrd <$> mapM IO.canonicalizePath files - putStrLn $ "Found " ++ show (length files) ++ " files" + absoluteFiles <- nubOrd <$> mapM IO.canonicalizePath files + putStrLn $ "Found " ++ show (length absoluteFiles) ++ " files" putStrLn "\nStep 2/4: Looking for hie.yaml files that control setup" - cradles <- mapM findCradle files + cradles <- mapM findCradle absoluteFiles let ucradles = nubOrd cradles let n = length ucradles putStrLn $ "Found " ++ show n ++ " cradle" ++ ['s' | n /= 1] @@ -380,25 +377,25 @@ defaultMain recorder Arguments{..} = withHeapStats (cmapWithPrio LogHeapStats re putStrLn "\nStep 3/4: Initializing the IDE" sessionLoader <- loadSessionWithOptions (cmapWithPrio LogSession recorder) argsSessionLoadingOptions dir let def_options = argsIdeOptions argsDefaultHlsConfig sessionLoader - options = def_options + ideOptions = def_options { optCheckParents = pure NeverCheck , optCheckProject = pure False , optModifyDynFlags = optModifyDynFlags def_options <> pluginModifyDynflags plugins } - ide <- initialise (cmapWithPrio LogService recorder) argsDefaultHlsConfig argsHlsPlugins rules Nothing logger debouncer options hiedb hieChan mempty + ide <- initialise (cmapWithPrio LogService recorder) argsDefaultHlsConfig argsHlsPlugins rules Nothing logger debouncer ideOptions hiedb hieChan mempty shakeSessionInit (cmapWithPrio LogShake recorder) ide registerIdeConfiguration (shakeExtras ide) $ IdeConfiguration mempty (hashed Nothing) putStrLn "\nStep 4/4: Type checking the files" - setFilesOfInterest ide $ HashMap.fromList $ map ((,OnDisk) . toNormalizedFilePath') files - results <- runAction "User TypeCheck" ide $ uses TypeCheck (map toNormalizedFilePath' files) - _results <- runAction "GetHie" ide $ uses GetHieAst (map toNormalizedFilePath' files) - _results <- runAction "GenerateCore" ide $ uses GenerateCore (map toNormalizedFilePath' files) - let (worked, failed) = partition fst $ zip (map isJust results) files + setFilesOfInterest ide $ HashMap.fromList $ map ((,OnDisk) . toNormalizedFilePath') absoluteFiles + results <- runAction "User TypeCheck" ide $ uses TypeCheck (map toNormalizedFilePath' absoluteFiles) + _results <- runAction "GetHie" ide $ uses GetHieAst (map toNormalizedFilePath' absoluteFiles) + _results <- runAction "GenerateCore" ide $ uses GenerateCore (map toNormalizedFilePath' absoluteFiles) + let (worked, failed) = partition fst $ zip (map isJust results) absoluteFiles when (failed /= []) $ putStr $ unlines $ "Files that failed:" : map ((++) " * " . snd) failed - let nfiles xs = let n = length xs in if n == 1 then "1 file" else show n ++ " files" + let nfiles xs = let n' = length xs in if n' == 1 then "1 file" else show n' ++ " files" putStrLn $ "\nCompleted (" ++ nfiles worked ++ " worked, " ++ nfiles failed ++ " failed)" unless (null failed) (exitWith $ ExitFailure (length failed)) @@ -418,12 +415,12 @@ defaultMain recorder Arguments{..} = withHeapStats (cmapWithPrio LogHeapStats re runWithDb (cmapWithPrio LogSession recorder) dbLoc $ \hiedb hieChan -> do sessionLoader <- loadSessionWithOptions (cmapWithPrio LogSession recorder) argsSessionLoadingOptions "." let def_options = argsIdeOptions argsDefaultHlsConfig sessionLoader - options = def_options + ideOptions = def_options { optCheckParents = pure NeverCheck , optCheckProject = pure False , optModifyDynFlags = optModifyDynFlags def_options <> pluginModifyDynflags plugins } - ide <- initialise (cmapWithPrio LogService recorder) argsDefaultHlsConfig argsHlsPlugins rules Nothing logger debouncer options hiedb hieChan mempty + ide <- initialise (cmapWithPrio LogService recorder) argsDefaultHlsConfig argsHlsPlugins rules Nothing logger debouncer ideOptions hiedb hieChan mempty shakeSessionInit (cmapWithPrio LogShake recorder) ide registerIdeConfiguration (shakeExtras ide) $ IdeConfiguration mempty (hashed Nothing) c ide @@ -435,9 +432,9 @@ expandFiles = concatMapM $ \x -> do then return [x] else do let recurse "." = True - recurse x | "." `isPrefixOf` takeFileName x = False -- skip .git etc - recurse x = takeFileName x `notElem` ["dist", "dist-newstyle"] -- cabal directories - files <- filter (\x -> takeExtension x `elem` [".hs", ".lhs"]) <$> IO.listFilesInside (return . recurse) x + recurse y | "." `isPrefixOf` takeFileName y = False -- skip .git etc + recurse y = takeFileName y `notElem` ["dist", "dist-newstyle"] -- cabal directories + files <- filter (\y -> takeExtension y `elem` [".hs", ".lhs"]) <$> IO.listFilesInside (return . recurse) x when (null files) $ fail $ "Couldn't find any .hs/.lhs files inside directory: " ++ x return files diff --git a/ghcide/src/Development/IDE/Main/HeapStats.hs b/ghcide/src/Development/IDE/Main/HeapStats.hs index ac1af8f28e..0a19f6339b 100644 --- a/ghcide/src/Development/IDE/Main/HeapStats.hs +++ b/ghcide/src/Development/IDE/Main/HeapStats.hs @@ -19,7 +19,7 @@ data Log deriving Show instance Pretty Log where - pretty log = case log of + pretty = \case LogHeapStatsPeriod period -> "Logging heap statistics every" <+> pretty (toFormattedSeconds period) LogHeapStatsDisabled -> diff --git a/ghcide/src/Development/IDE/Monitoring/OpenTelemetry.hs b/ghcide/src/Development/IDE/Monitoring/OpenTelemetry.hs index 2a6efa3d2e..184a5c1ba9 100644 --- a/ghcide/src/Development/IDE/Monitoring/OpenTelemetry.hs +++ b/ghcide/src/Development/IDE/Monitoring/OpenTelemetry.hs @@ -15,9 +15,9 @@ monitoring :: IO Monitoring monitoring | userTracingEnabled = do actions <- newIORef [] - let registerCounter name read = do + let registerCounter name readA = do observer <- mkValueObserver (encodeUtf8 name) - let update = observe observer . fromIntegral =<< read + let update = observe observer . fromIntegral =<< readA atomicModifyIORef'_ actions (update :) registerGauge = registerCounter let start = do diff --git a/ghcide/src/Development/IDE/Plugin/Completions.hs b/ghcide/src/Development/IDE/Plugin/Completions.hs index 406b86bb65..9fd919e9d9 100644 --- a/ghcide/src/Development/IDE/Plugin/Completions.hs +++ b/ghcide/src/Development/IDE/Plugin/Completions.hs @@ -24,7 +24,8 @@ import Development.IDE.Core.PluginUtils import Development.IDE.Core.PositionMapping import Development.IDE.Core.RuleTypes import Development.IDE.Core.Service hiding (Log, LogShake) -import Development.IDE.Core.Shake hiding (Log) +import Development.IDE.Core.Shake hiding (Log, + knownTargets) import qualified Development.IDE.Core.Shake as Shake import Development.IDE.GHC.Compat import Development.IDE.GHC.Util @@ -49,6 +50,7 @@ import Language.LSP.Protocol.Message import Language.LSP.Protocol.Types import qualified Language.LSP.Server as LSP import Numeric.Natural +import Prelude hiding (mod) import Text.Fuzzy.Parallel (Scored (..)) import Development.IDE.Core.Rules (usePropertyAction) @@ -63,7 +65,7 @@ data Log = LogShake Shake.Log deriving Show instance Pretty Log where pretty = \case - LogShake log -> pretty log + LogShake msg -> pretty msg ghcideCompletionsPluginPriority :: Natural ghcideCompletionsPluginPriority = defaultPluginPriority @@ -82,8 +84,8 @@ produceCompletions :: Recorder (WithPriority Log) -> Rules () produceCompletions recorder = do define (cmapWithPrio LogShake recorder) $ \LocalCompletions file -> do let uri = fromNormalizedUri $ normalizedFilePathToUri file - pm <- useWithStale GetParsedModule file - case pm of + mbPm <- useWithStale GetParsedModule file + case mbPm of Just (pm, _) -> do let cdata = localCompletionsForParsedModule uri pm return ([], Just cdata) @@ -93,9 +95,9 @@ produceCompletions recorder = do -- synthesizing a fake module with an empty body from the buffer -- in the ModSummary, which preserves all the imports ms <- fmap fst <$> useWithStale GetModSummaryWithoutTimestamps file - sess <- fmap fst <$> useWithStale GhcSessionDeps file + mbSess <- fmap fst <$> useWithStale GhcSessionDeps file - case (ms, sess) of + case (ms, mbSess) of (Just ModSummaryResult{..}, Just sess) -> do let env = hscEnv sess -- We do this to be able to provide completions of items that are not restricted to the explicit list @@ -140,8 +142,8 @@ resolveCompletion ide _pid comp@CompletionItem{_detail,_documentation,_data_} ur #endif mdkm <- liftIO $ runIdeAction "CompletionResolve.GetDocMap" (shakeExtras ide) $ useWithStaleFast GetDocMap file let (dm,km) = case mdkm of - Just (DKMap dm km, _) -> (dm,km) - Nothing -> (mempty, mempty) + Just (DKMap docMap kindMap, _) -> (docMap,kindMap) + Nothing -> (mempty, mempty) doc <- case lookupNameEnv dm name of Just doc -> pure $ spanDocToMarkdown doc Nothing -> liftIO $ spanDocToMarkdown <$> getDocumentationTryGhc (hscEnv sess) name diff --git a/ghcide/src/Development/IDE/Plugin/Completions/Logic.hs b/ghcide/src/Development/IDE/Plugin/Completions/Logic.hs index d8409b502c..d615611ca6 100644 --- a/ghcide/src/Development/IDE/Plugin/Completions/Logic.hs +++ b/ghcide/src/Development/IDE/Plugin/Completions/Logic.hs @@ -15,7 +15,8 @@ module Development.IDE.Plugin.Completions.Logic ( ) where import Control.Applicative -import Control.Lens hiding (Context) +import Control.Lens hiding (Context, + parts) import Data.Char (isAlphaNum, isUpper) import Data.Default (def) import Data.Generics @@ -23,6 +24,7 @@ import Data.List.Extra as List hiding (stripPrefix) import qualified Data.Map as Map import Data.Row +import Prelude hiding (mod) import Data.Maybe (fromMaybe, isJust, isNothing, @@ -40,7 +42,7 @@ import Data.Monoid (First (..)) import Data.Ord (Down (Down)) import qualified Data.Set as Set import Development.IDE.Core.PositionMapping -import Development.IDE.GHC.Compat hiding (ppr) +import Development.IDE.GHC.Compat hiding (isQual, ppr) import qualified Development.IDE.GHC.Compat as GHC import Development.IDE.GHC.Compat.Util import Development.IDE.GHC.CoreFile (occNamePrefixes) @@ -61,7 +63,7 @@ import Text.Fuzzy.Parallel (Scored (score), original) import qualified Data.Text.Utf16.Rope as Rope -import Development.IDE +import Development.IDE hiding (line) import Development.IDE.Spans.AtPoint (pointCommand) @@ -319,14 +321,14 @@ defaultCompletionItemWithLabel label = def def def def def def def def def fromIdentInfo :: Uri -> IdentInfo -> Maybe T.Text -> CompItem -fromIdentInfo doc id@IdentInfo{..} q = CI +fromIdentInfo doc identInfo@IdentInfo{..} q = CI { compKind= occNameToComKind name , insertText=rend , provenance = DefinedIn mod , label=rend , typeText = Nothing , isInfix=Nothing - , isTypeCompl= not (isDatacon id) && isUpper (T.head rend) + , isTypeCompl= not (isDatacon identInfo) && isUpper (T.head rend) , additionalTextEdits= Just $ ExtendImport { doc, @@ -338,8 +340,8 @@ fromIdentInfo doc id@IdentInfo{..} q = CI , nameDetails = Nothing , isLocalCompletion = False } - where rend = rendered id - mod = moduleNameText id + where rend = rendered identInfo + mod = moduleNameText identInfo cacheDataProducer :: Uri -> [ModuleName] -> Module -> GlobalRdrEnv-> GlobalRdrEnv -> [LImportDecl GhcPs] -> CachedCompletions cacheDataProducer uri visibleMods curMod globalEnv inScopeEnv limports = @@ -445,34 +447,34 @@ localCompletionsForParsedModule uri pm@ParsedModule{pm_parsed_source = L _ HsMod } where typeSigIds = Set.fromList - [ id + [ identifier | L _ (SigD _ (TypeSig _ ids _)) <- hsmodDecls - , L _ id <- ids + , L _ identifier <- ids ] hasTypeSig = (`Set.member` typeSigIds) . unLoc compls = concat [ case decl of SigD _ (TypeSig _ ids typ) -> - [mkComp id CompletionItemKind_Function (Just $ showForSnippet typ) | id <- ids] + [mkComp identifier CompletionItemKind_Function (Just $ showForSnippet typ) | identifier <- ids] ValD _ FunBind{fun_id} -> [ mkComp fun_id CompletionItemKind_Function Nothing | not (hasTypeSig fun_id) ] ValD _ PatBind{pat_lhs} -> - [mkComp id CompletionItemKind_Variable Nothing - | VarPat _ id <- listify (\(_ :: Pat GhcPs) -> True) pat_lhs] + [mkComp identifier CompletionItemKind_Variable Nothing + | VarPat _ identifier <- listify (\(_ :: Pat GhcPs) -> True) pat_lhs] TyClD _ ClassDecl{tcdLName, tcdSigs, tcdATs} -> mkComp tcdLName CompletionItemKind_Interface (Just $ showForSnippet tcdLName) : - [ mkComp id CompletionItemKind_Function (Just $ showForSnippet typ) + [ mkComp identifier CompletionItemKind_Function (Just $ showForSnippet typ) | L _ (ClassOpSig _ _ ids typ) <- tcdSigs - , id <- ids] ++ + , identifier <- ids] ++ [ mkComp fdLName CompletionItemKind_Struct (Just $ showForSnippet fdLName) | L _ (FamilyDecl{fdLName}) <- tcdATs] TyClD _ x -> - let generalCompls = [mkComp id cl (Just $ showForSnippet $ tyClDeclLName x) - | id <- listify (\(_ :: LIdP GhcPs) -> True) x - , let cl = occNameToComKind (rdrNameOcc $ unLoc id)] + let generalCompls = [mkComp identifier cl (Just $ showForSnippet $ tyClDeclLName x) + | identifier <- listify (\(_ :: LIdP GhcPs) -> True) x + , let cl = occNameToComKind (rdrNameOcc $ unLoc identifier)] -- here we only have to look at the outermost type recordCompls = findRecordCompl uri (Local pos) x in @@ -676,9 +678,9 @@ getCompletions plugins ideOpts CC {allModNamesAsNS, anyQualCompls, unqualCompls, | otherwise = ((qual,) <$> Map.findWithDefault [] prefixScope (getQualCompls qualCompls)) ++ map (\compl -> (notQual, compl (Just prefixScope))) anyQualCompls - filtListWith f list = + filtListWith f xs = [ fmap f label - | label <- Fuzzy.simpleFilter chunkSize maxC fullPrefix list + | label <- Fuzzy.simpleFilter chunkSize maxC fullPrefix xs , enteredQual `T.isPrefixOf` original label ] diff --git a/ghcide/src/Development/IDE/Plugin/HLS.hs b/ghcide/src/Development/IDE/Plugin/HLS.hs index 7ef7eeed65..b70d19e0f2 100644 --- a/ghcide/src/Development/IDE/Plugin/HLS.hs +++ b/ghcide/src/Development/IDE/Plugin/HLS.hs @@ -91,7 +91,7 @@ noPluginEnabled recorder m fs' = do pluginNotEnabled method availPlugins = "No plugin enabled for " <> T.pack (show method) <> ", potentially available: " <> (T.intercalate ", " $ map (\(PluginId plid) -> plid) availPlugins) - + pluginDoesntExist :: PluginId -> Text pluginDoesntExist (PluginId pid) = "Plugin " <> pid <> " doesn't exist" @@ -232,9 +232,9 @@ executeCommandHandlers recorder ecs = requestHandler SMethod_WorkspaceExecuteCom -- --------------------------------------------------------------------- extensiblePlugins :: Recorder (WithPriority Log) -> [(PluginId, PluginDescriptor IdeState)] -> Plugin Config -extensiblePlugins recorder xs = mempty { P.pluginHandlers = handlers } +extensiblePlugins recorder plugins = mempty { P.pluginHandlers = handlers } where - IdeHandlers handlers' = foldMap bakePluginId xs + IdeHandlers handlers' = foldMap bakePluginId plugins bakePluginId :: (PluginId, PluginDescriptor IdeState) -> IdeHandlers bakePluginId (pid,pluginDesc) = IdeHandlers $ DMap.map (\(PluginHandler f) -> IdeHandler [(pid,pluginDesc,f pid)]) @@ -250,11 +250,11 @@ extensiblePlugins recorder xs = mempty { P.pluginHandlers = handlers } -- Clients generally don't display ResponseErrors so instead we log any that we come across case nonEmpty fs of Nothing -> liftIO $ noPluginEnabled recorder m ((\(x, _, _) -> x) <$> fs') - Just fs -> do - let handlers = fmap (\(plid,_,handler) -> (plid,handler)) fs - es <- runConcurrently exceptionInPlugin m handlers ide params + Just neFs -> do + let plidsAndHandlers = fmap (\(plid,_,handler) -> (plid,handler)) neFs + es <- runConcurrently exceptionInPlugin m plidsAndHandlers ide params caps <- LSP.getClientCapabilities - let (errs,succs) = partitionEithers $ toList $ join $ NE.zipWith (\(pId,_) -> fmap (first (pId,))) handlers es + let (errs,succs) = partitionEithers $ toList $ join $ NE.zipWith (\(pId,_) -> fmap (first (pId,))) plidsAndHandlers es liftIO $ unless (null errs) $ logErrors recorder errs case nonEmpty succs of Nothing -> do @@ -288,12 +288,12 @@ extensibleNotificationPlugins recorder xs = mempty { P.pluginHandlers = handlers case nonEmpty fs of Nothing -> do logWith recorder Warning (LogNoPluginForMethod $ Some m) - Just fs -> do + Just neFs -> do -- We run the notifications in order, so the core ghcide provider -- (which restarts the shake process) hopefully comes last mapM_ (\(pid,_,f) -> otTracedProvider pid (fromString $ show m) $ f ide vfs params `catchAny` -- See Note [Exception handling in plugins] - (\e -> logWith recorder Warning (ExceptionInPlugin pid (Some m) e))) fs + (\e -> logWith recorder Warning (ExceptionInPlugin pid (Some m) e))) neFs -- --------------------------------------------------------------------- @@ -344,14 +344,14 @@ newtype IdeNotificationHandlers = IdeNotificationHandlers (DMap IdeNotification instance Semigroup IdeHandlers where (IdeHandlers a) <> (IdeHandlers b) = IdeHandlers $ DMap.unionWithKey go a b where - go _ (IdeHandler a) (IdeHandler b) = IdeHandler (a <> b) + go _ (IdeHandler c) (IdeHandler d) = IdeHandler (c <> d) instance Monoid IdeHandlers where mempty = IdeHandlers mempty instance Semigroup IdeNotificationHandlers where (IdeNotificationHandlers a) <> (IdeNotificationHandlers b) = IdeNotificationHandlers $ DMap.unionWithKey go a b where - go _ (IdeNotificationHandler a) (IdeNotificationHandler b) = IdeNotificationHandler (a <> b) + go _ (IdeNotificationHandler c) (IdeNotificationHandler d) = IdeNotificationHandler (c <> d) instance Monoid IdeNotificationHandlers where mempty = IdeNotificationHandlers mempty diff --git a/ghcide/src/Development/IDE/Plugin/HLS/GhcIde.hs b/ghcide/src/Development/IDE/Plugin/HLS/GhcIde.hs index 1c1cb8c5b2..b29e965afb 100644 --- a/ghcide/src/Development/IDE/Plugin/HLS/GhcIde.hs +++ b/ghcide/src/Development/IDE/Plugin/HLS/GhcIde.hs @@ -27,9 +27,9 @@ data Log instance Pretty Log where pretty = \case - LogNotifications log -> pretty log - LogCompletions log -> pretty log - LogTypeLenses log -> pretty log + LogNotifications msg -> pretty msg + LogCompletions msg -> pretty msg + LogTypeLenses msg -> pretty msg descriptors :: Recorder (WithPriority Log) -> [PluginDescriptor IdeState] descriptors recorder = diff --git a/ghcide/src/Development/IDE/Plugin/TypeLenses.hs b/ghcide/src/Development/IDE/Plugin/TypeLenses.hs index 87b9906d9c..cc77a33e27 100644 --- a/ghcide/src/Development/IDE/Plugin/TypeLenses.hs +++ b/ghcide/src/Development/IDE/Plugin/TypeLenses.hs @@ -86,7 +86,7 @@ data Log = LogShake Shake.Log deriving Show instance Pretty Log where pretty = \case - LogShake log -> pretty log + LogShake msg -> pretty msg typeLensCommandId :: T.Text @@ -313,11 +313,11 @@ gblBindingType (Just hsc) (Just gblEnv) = do showDoc = showDocRdrEnv hsc rdrEnv hasSig :: (Monad m) => Name -> m a -> m (Maybe a) hasSig name f = whenMaybe (name `elemNameSet` sigs) f - bindToSig id = do - let name = idName id + bindToSig identifier = do + let name = idName identifier hasSig name $ do env <- tcInitTidyEnv - let (_, ty) = tidyOpenType env (idType id) + let (_, ty) = tidyOpenType env (idType identifier) pure $ GlobalBindingTypeSig name (printName name <> " :: " <> showDoc (pprSigmaType ty)) (name `elemNameSet` exports) patToSig p = do let name = patSynName p diff --git a/ghcide/src/Development/IDE/Spans/AtPoint.hs b/ghcide/src/Development/IDE/Spans/AtPoint.hs index 54b1015cfd..8a39c2e5c1 100644 --- a/ghcide/src/Development/IDE/Spans/AtPoint.hs +++ b/ghcide/src/Development/IDE/Spans/AtPoint.hs @@ -30,6 +30,7 @@ import Development.IDE.GHC.Orphans () import Development.IDE.Types.Location import Language.LSP.Protocol.Types hiding (SemanticTokenAbsolute (..)) +import Prelude hiding (mod) -- compiler and infrastructure import Development.IDE.Core.PositionMapping @@ -58,7 +59,8 @@ import Data.List.Extra (dropEnd1, nubOrd) import Data.Version (showVersion) import Development.IDE.Types.Shake (WithHieDb) -import HieDb hiding (pointCommand) +import HieDb hiding (pointCommand, + withHieDb) import System.Directory (doesFileExist) -- | Gives a Uri for the module, given the .hie file location and the the module info @@ -93,11 +95,11 @@ foiReferencesAtPoint file pos (FOIReferences asts) = Just (HAR _ hf _ _ _,mapping) -> let names = getNamesAtPoint hf pos mapping adjustedLocs = HM.foldr go [] asts - go (HAR _ _ rf tr _, mapping) xs = refs ++ typerefs ++ xs + go (HAR _ _ rf tr _, goMapping) xs = refs ++ typerefs ++ xs where - refs = mapMaybe (toCurrentLocation mapping . realSrcSpanToLocation . fst) + refs = mapMaybe (toCurrentLocation goMapping . realSrcSpanToLocation . fst) $ concat $ mapMaybe (\n -> M.lookup (Right n) rf) names - typerefs = mapMaybe (toCurrentLocation mapping . realSrcSpanToLocation) + typerefs = mapMaybe (toCurrentLocation goMapping . realSrcSpanToLocation) $ concat $ mapMaybe (`M.lookup` tr) names in (names, adjustedLocs,map fromNormalizedFilePath $ HM.keys asts) @@ -133,8 +135,8 @@ referencesAtPoint withHieDb nfp pos refs = do typeRefs <- forM names $ \name -> case nameModule_maybe name of Just mod | isTcClsNameSpace (occNameSpace $ nameOccName name) -> do - refs <- liftIO $ withHieDb (\hieDb -> findTypeRefs hieDb True (nameOccName name) (Just $ moduleName mod) (Just $ moduleUnit mod) exclude) - pure $ mapMaybe typeRowToLoc refs + refs' <- liftIO $ withHieDb (\hieDb -> findTypeRefs hieDb True (nameOccName name) (Just $ moduleName mod) (Just $ moduleUnit mod) exclude) + pure $ mapMaybe typeRowToLoc refs' _ -> pure [] pure $ nubOrd $ foiRefs ++ concat nonFOIRefs ++ concat typeRefs @@ -270,7 +272,7 @@ atPoint IdeOptions{} (HAR _ hf _ _ (kind :: HieKind hietype)) (DKMap dm km) env prettyPackageName :: Name -> Maybe T.Text prettyPackageName n = do m <- nameModule_maybe n - pkgTxt <- packageNameWithVersion m env + pkgTxt <- packageNameWithVersion m pure $ "*(" <> pkgTxt <> ")*" -- Return the module text itself and @@ -279,14 +281,14 @@ atPoint IdeOptions{} (HAR _ hf _ _ (kind :: HieKind hietype)) (DKMap dm km) env packageNameForImportStatement mod = do mpkg <- findImportedModule env mod :: IO (Maybe Module) let moduleName = printOutputable mod - case mpkg >>= flip packageNameWithVersion env of + case mpkg >>= packageNameWithVersion of Nothing -> pure moduleName Just pkgWithVersion -> pure $ moduleName <> "\n\n" <> pkgWithVersion -- Return the package name and version of a module. -- For example, given module `Data.List`, it should return something like `base-4.x`. - packageNameWithVersion :: Module -> HscEnv -> Maybe T.Text - packageNameWithVersion m env = do + packageNameWithVersion :: Module -> Maybe T.Text + packageNameWithVersion m = do let pid = moduleUnit m conf <- lookupUnit env pid let pkgName = T.pack $ unitPackageNameString conf @@ -331,20 +333,20 @@ typeLocationsAtPoint withHieDb lookupModule _ideOptions pos (HAR _ ast _ _ hieKi unfold = map (arr A.!) getts x = nodeType ni ++ (mapMaybe identType $ M.elems $ nodeIdentifiers ni) where ni = nodeInfo' x - getTypes ts = flip concatMap (unfold ts) $ \case + getTypes' ts' = flip concatMap (unfold ts') $ \case HTyVarTy n -> [n] - HAppTy a (HieArgs xs) -> getTypes (a : map snd xs) - HTyConApp tc (HieArgs xs) -> ifaceTyConName tc : getTypes (map snd xs) - HForAllTy _ a -> getTypes [a] + HAppTy a (HieArgs xs) -> getTypes' (a : map snd xs) + HTyConApp tc (HieArgs xs) -> ifaceTyConName tc : getTypes' (map snd xs) + HForAllTy _ a -> getTypes' [a] #if MIN_VERSION_ghc(9,0,1) - HFunTy a b c -> getTypes [a,b,c] + HFunTy a b c -> getTypes' [a,b,c] #else HFunTy a b -> getTypes [a,b] #endif - HQualTy a b -> getTypes [a,b] - HCastTy a -> getTypes [a] + HQualTy a b -> getTypes' [a,b] + HCastTy a -> getTypes' [a] _ -> [] - in fmap nubOrd $ concatMapM (fmap (fromMaybe []) . nameToLocation withHieDb lookupModule) (getTypes ts) + in fmap nubOrd $ concatMapM (fmap (fromMaybe []) . nameToLocation withHieDb lookupModule) (getTypes' ts) HieFresh -> let ts = concat $ pointCommand ast pos getts getts x = nodeType ni ++ (mapMaybe identType $ M.elems $ nodeIdentifiers ni) @@ -412,8 +414,8 @@ nameToLocation withHieDb lookupModule name = runMaybeT $ -- This is a hack to make find definition work better with ghcide's nascent multi-component support, -- where names from a component that has been indexed in a previous session but not loaded in this -- session may end up with different unit ids - erow <- liftIO $ withHieDb (\hieDb -> findDef hieDb (nameOccName name) (Just $ moduleName mod) Nothing) - case erow of + erow' <- liftIO $ withHieDb (\hieDb -> findDef hieDb (nameOccName name) (Just $ moduleName mod) Nothing) + case erow' of [] -> MaybeT $ pure Nothing xs -> lift $ mapMaybeM (runMaybeT . defRowToLocation lookupModule) xs xs -> lift $ mapMaybeM (runMaybeT . defRowToLocation lookupModule) xs diff --git a/ghcide/src/Development/IDE/Spans/Documentation.hs b/ghcide/src/Development/IDE/Spans/Documentation.hs index 9ae4e7ce01..4bbe3018ac 100644 --- a/ghcide/src/Development/IDE/Spans/Documentation.hs +++ b/ghcide/src/Development/IDE/Spans/Documentation.hs @@ -30,6 +30,7 @@ import Development.IDE.GHC.Error import Development.IDE.GHC.Util (printOutputable) import Development.IDE.Spans.Common import Language.LSP.Protocol.Types (filePathToUri, getUri) +import Prelude hiding (mod) import System.Directory import System.FilePath @@ -56,17 +57,17 @@ mkDocMap env rm this_mod = k <- foldrM getType (tcg_type_env this_mod) names pure $ DKMap d k where - getDocs n map - | maybe True (mod ==) $ nameModule_maybe n = pure map -- we already have the docs in this_docs, or they do not exist + getDocs n nameMap + | maybe True (mod ==) $ nameModule_maybe n = pure nameMap -- we already have the docs in this_docs, or they do not exist | otherwise = do doc <- getDocumentationTryGhc env n - pure $ extendNameEnv map n doc - getType n map + pure $ extendNameEnv nameMap n doc + getType n nameMap | isTcOcc $ occName n - , Nothing <- lookupNameEnv map n + , Nothing <- lookupNameEnv nameMap n = do kind <- lookupKind env n - pure $ maybe map (extendNameEnv map n) kind - | otherwise = pure map + pure $ maybe nameMap (extendNameEnv nameMap n) kind + | otherwise = pure nameMap names = rights $ S.toList idents idents = M.keysSet rm mod = tcg_mod this_mod @@ -82,8 +83,8 @@ getDocumentationTryGhc env n = getDocumentationsTryGhc :: HscEnv -> [Name] -> IO [SpanDoc] getDocumentationsTryGhc env names = do - res <- catchSrcErrors (hsc_dflags env) "docs" $ getDocsBatch env names - case res of + resOr <- catchSrcErrors (hsc_dflags env) "docs" $ getDocsBatch env names + case resOr of Left _ -> return [] Right res -> zipWithM unwrap res names where diff --git a/ghcide/src/Development/IDE/Spans/Pragmas.hs b/ghcide/src/Development/IDE/Spans/Pragmas.hs index a88fca987d..d0ec2c1576 100644 --- a/ghcide/src/Development/IDE/Spans/Pragmas.hs +++ b/ghcide/src/Development/IDE/Spans/Pragmas.hs @@ -28,8 +28,8 @@ import Development.IDE.Core.PluginUtils import qualified Language.LSP.Protocol.Lens as L getNextPragmaInfo :: DynFlags -> Maybe Text -> NextPragmaInfo -getNextPragmaInfo dynFlags sourceText = - if | Just sourceText <- sourceText +getNextPragmaInfo dynFlags mbSourceText = + if | Just sourceText <- mbSourceText , let sourceStringBuffer = stringToStringBuffer (Text.unpack sourceText) , POk _ parserState <- parsePreDecl dynFlags sourceStringBuffer -> case parserState of @@ -99,8 +99,8 @@ isDownwardLineHaddock = List.isPrefixOf "-- |" -- need to merge tokens that are deleted/inserted into one TextEdit each -- to work around some weird TextEdits applied in reversed order issue updateLineSplitTextEdits :: LSP.Range -> String -> Maybe LineSplitTextEdits -> LineSplitTextEdits -updateLineSplitTextEdits tokenRange tokenString prevLineSplitTextEdits - | Just prevLineSplitTextEdits <- prevLineSplitTextEdits +updateLineSplitTextEdits tokenRange tokenString mbPrevLineSplitTextEdits + | Just prevLineSplitTextEdits <- mbPrevLineSplitTextEdits , let LineSplitTextEdits { lineSplitInsertTextEdit = prevInsertTextEdit , lineSplitDeleteTextEdit = prevDeleteTextEdit } = prevLineSplitTextEdits @@ -291,8 +291,8 @@ updateParserState token range prevParserState | otherwise = prevParserState where hasDeleteStartedOnSameLine :: Int -> Maybe LineSplitTextEdits -> Bool - hasDeleteStartedOnSameLine line lineSplitTextEdits - | Just lineSplitTextEdits <- lineSplitTextEdits + hasDeleteStartedOnSameLine line mbLineSplitTextEdits + | Just lineSplitTextEdits <- mbLineSplitTextEdits , let LineSplitTextEdits{ lineSplitDeleteTextEdit } = lineSplitTextEdits , let LSP.TextEdit deleteRange _ = lineSplitDeleteTextEdit , let LSP.Range _ deleteEndPosition = deleteRange diff --git a/ghcide/src/Development/IDE/Types/Exports.hs b/ghcide/src/Development/IDE/Types/Exports.hs index 3a507eb3c0..60ac50e7b4 100644 --- a/ghcide/src/Development/IDE/Types/Exports.hs +++ b/ghcide/src/Development/IDE/Types/Exports.hs @@ -33,7 +33,8 @@ import Data.Text.Encoding (decodeUtf8, encodeUtf8) import Development.IDE.GHC.Compat import Development.IDE.GHC.Orphans () import GHC.Generics (Generic) -import HieDb +import HieDb hiding (withHieDb) +import Prelude hiding (mod) data ExportsMap = ExportsMap @@ -42,7 +43,7 @@ data ExportsMap = ExportsMap } instance NFData ExportsMap where - rnf (ExportsMap a b) = foldOccEnv (\a b -> rnf a `seq` b) (seqEltsUFM rnf b) a + rnf (ExportsMap a b) = foldOccEnv (\c d -> rnf c `seq` d) (seqEltsUFM rnf b) a instance Show ExportsMap where show (ExportsMap occs mods) = @@ -140,8 +141,8 @@ mkIdentInfos mod (AvailFL fl) = mkIdentInfos mod (AvailTC parent (n:nn) flds) -- Following the GHC convention that parent == n if parent is exported | n == parent - = [ IdentInfo (nameOccName n) (Just $! nameOccName parent) mod - | n <- nn ++ map flSelector flds + = [ IdentInfo (nameOccName name) (Just $! nameOccName parent) mod + | name <- nn ++ map flSelector flds ] ++ [ IdentInfo (nameOccName n) Nothing mod] @@ -198,7 +199,7 @@ unpackAvail mn | nonInternalModules mn = map f . mkIdentInfos mn | otherwise = const [] where - f id@IdentInfo {..} = (name, mn, Set.singleton id) + f identInfo@IdentInfo {..} = (name, mn, Set.singleton identInfo) identInfoToKeyVal :: IdentInfo -> (ModuleName, IdentInfo) diff --git a/ghcide/src/Development/IDE/Types/HscEnvEq.hs b/ghcide/src/Development/IDE/Types/HscEnvEq.hs index 623e1da691..bb8653ac77 100644 --- a/ghcide/src/Development/IDE/Types/HscEnvEq.hs +++ b/ghcide/src/Development/IDE/Types/HscEnvEq.hs @@ -22,7 +22,7 @@ import Data.Set (Set) import qualified Data.Set as Set import Data.Unique (Unique) import qualified Data.Unique as Unique -import Development.IDE.GHC.Compat +import Development.IDE.GHC.Compat hiding (newUnique) import qualified Development.IDE.GHC.Compat.Util as Maybes import Development.IDE.GHC.Error (catchSrcErrors) import Development.IDE.GHC.Util (lookupPackageConfig) diff --git a/ghcide/src/Generics/SYB/GHC.hs b/ghcide/src/Generics/SYB/GHC.hs index 8aaf99fa32..f0d600c87d 100644 --- a/ghcide/src/Generics/SYB/GHC.hs +++ b/ghcide/src/Generics/SYB/GHC.hs @@ -31,7 +31,7 @@ genericIsSubspan :: SrcSpan -> GenericQ (Maybe (Bool, ast)) genericIsSubspan _ dst = mkQ Nothing $ \case - (L span ast :: Located ast) -> Just (dst `isSubspanOf` span, ast) + (L srcSpan ast :: Located ast) -> Just (dst `isSubspanOf` srcSpan, ast) -- | Lift a function that replaces a value with several values into a generic From 8cf7641af014f8f29a8fd1da1a6994f9ec59de69 Mon Sep 17 00:00:00 2001 From: Nathan Maxson Date: Tue, 15 Aug 2023 19:36:54 +0300 Subject: [PATCH 08/18] Fix build errors --- ghcide/ghcide.cabal | 3 ++- ghcide/src/Development/IDE/GHC/Compat/Env.hs | 10 +++++----- ghcide/src/Development/IDE/LSP/Outline.hs | 8 ++++++-- ghcide/src/Development/IDE/Spans/AtPoint.hs | 2 +- 4 files changed, 14 insertions(+), 9 deletions(-) diff --git a/ghcide/ghcide.cabal b/ghcide/ghcide.cabal index 7a111928a0..fee37df4da 100644 --- a/ghcide/ghcide.cabal +++ b/ghcide/ghcide.cabal @@ -234,7 +234,8 @@ library if flag(pedantic) ghc-options: -Werror - -Wwarn=unused-packages + -Wwarn=unused-packages + -Wwarn=unrecognised-pragmas -Wwarn=dodgy-imports -Wwarn=missing-signatures -Wwarn=duplicate-exports diff --git a/ghcide/src/Development/IDE/GHC/Compat/Env.hs b/ghcide/src/Development/IDE/GHC/Compat/Env.hs index 644b417e65..43bc4825e6 100644 --- a/ghcide/src/Development/IDE/GHC/Compat/Env.hs +++ b/ghcide/src/Development/IDE/GHC/Compat/Env.hs @@ -64,7 +64,7 @@ import Module #if MIN_VERSION_ghc(9,0,0) import GHC.Driver.Hooks (Hooks) -import GHC.Driver.Session hiding (mkHomeModule, ways) +import GHC.Driver.Session hiding (mkHomeModule) import GHC.Unit.Types (Module, UnitId) #endif @@ -286,13 +286,13 @@ hostFullWays = #endif setWays :: Ways -> DynFlags -> DynFlags -setWays ways flags = +setWays newWays flags = #if MIN_VERSION_ghc(9,2,0) - flags { Session.targetWays_ = ways} + flags { Session.targetWays_ = newWays} #elif MIN_VERSION_ghc(9,0,0) - flags {ways = ways} + flags {ways = newWays} #else - updateWays $ flags {ways = ways} + updateWays $ flags {ways = newWays} #endif -- ------------------------------------------------------- diff --git a/ghcide/src/Development/IDE/LSP/Outline.hs b/ghcide/src/Development/IDE/LSP/Outline.hs index fd9c45c8cf..4afc7c7dc1 100644 --- a/ghcide/src/Development/IDE/LSP/Outline.hs +++ b/ghcide/src/Development/IDE/LSP/Outline.hs @@ -108,11 +108,11 @@ documentSymbolForDecl (L (locA -> (RealSrcSpan l _)) (TyClD _ DataDecl { tcdLNam , _kind = SymbolKind_Struct , _children = Just $ - [ (defDocumentSymbol l'' :: DocumentSymbol) +#if MIN_VERSION_ghc(9,2,0) + [ (defDocumentSymbol l'' :: DocumentSymbol) { _name = printOutputable n , _kind = SymbolKind_Constructor , _selectionRange = realSrcSpanToRange l' -#if MIN_VERSION_ghc(9,2,0) , _children = toList <$> nonEmpty childs } | con <- extract_cons dd_cons @@ -140,6 +140,10 @@ documentSymbolForDecl (L (locA -> (RealSrcSpan l _)) (TyClD _ DataDecl { tcdLNam } cvtFld _ = Nothing #else + [ (defDocumentSymbol l :: DocumentSymbol) + { _name = printOutputable n + , _kind = SymbolKind_Constructor + , _selectionRange = realSrcSpanToRange l' , _children = conArgRecordFields (con_args x) } | L (locA -> (RealSrcSpan l _ )) x <- dd_cons diff --git a/ghcide/src/Development/IDE/Spans/AtPoint.hs b/ghcide/src/Development/IDE/Spans/AtPoint.hs index 8a39c2e5c1..afd51f1f30 100644 --- a/ghcide/src/Development/IDE/Spans/AtPoint.hs +++ b/ghcide/src/Development/IDE/Spans/AtPoint.hs @@ -341,7 +341,7 @@ typeLocationsAtPoint withHieDb lookupModule _ideOptions pos (HAR _ ast _ _ hieKi #if MIN_VERSION_ghc(9,0,1) HFunTy a b c -> getTypes' [a,b,c] #else - HFunTy a b -> getTypes [a,b] + HFunTy a b -> getTypes' [a,b] #endif HQualTy a b -> getTypes' [a,b] HCastTy a -> getTypes' [a] From 4b527c7466fbda0714975892256980d0c64825b8 Mon Sep 17 00:00:00 2001 From: Nathan Maxson Date: Tue, 15 Aug 2023 20:06:10 +0300 Subject: [PATCH 09/18] turn on pedantic for 9.0 and 9.2, and temp disable fast fail --- .github/workflows/flags.yml | 6 ++---- 1 file changed, 2 insertions(+), 4 deletions(-) diff --git a/.github/workflows/flags.yml b/.github/workflows/flags.yml index b5e94ec584..fa894b0f61 100644 --- a/.github/workflows/flags.yml +++ b/.github/workflows/flags.yml @@ -47,7 +47,7 @@ jobs: needs: pre_job runs-on: ${{ matrix.os }} strategy: - fail-fast: true + fail-fast: false matrix: ghc: ${{ fromJSON(needs.pre_job.outputs.ghcs) }} os: @@ -75,9 +75,7 @@ jobs: - name: Build `ghcide` with flags run: cabal v2-build ghcide --flags="ghc-patched-unboxed-bytecode test-exe executable bench-exe ekg" - # we have to clean up warnings for 9.0 and 9.2 before enable -Wall - - if: matrix.ghc != '9.0' && matrix.ghc != '9.2' - name: Build with pedantic (-WError) + - name: Build with pedantic (-WError) run: cabal v2-build --flags="pedantic" flags_post_job: From 93fbde8eb91b875f86fd3f5ccf94569bf4c569b2 Mon Sep 17 00:00:00 2001 From: Nathan Maxson Date: Tue, 15 Aug 2023 20:06:31 +0300 Subject: [PATCH 10/18] fix 9.6 flags issue --- ghcide/src/Development/IDE/Import/DependencyInformation.hs | 4 ++++ 1 file changed, 4 insertions(+) diff --git a/ghcide/src/Development/IDE/Import/DependencyInformation.hs b/ghcide/src/Development/IDE/Import/DependencyInformation.hs index 03363c4570..a7460487cc 100644 --- a/ghcide/src/Development/IDE/Import/DependencyInformation.hs +++ b/ghcide/src/Development/IDE/Import/DependencyInformation.hs @@ -1,5 +1,6 @@ -- Copyright (c) 2019 The DAML Authors. All rights reserved. -- SPDX-License-Identifier: Apache-2.0 +{-# LANGUAGE CPP #-} module Development.IDE.Import.DependencyInformation ( DependencyInformation(..) @@ -55,7 +56,10 @@ import Development.IDE.Types.Diagnostics import Development.IDE.Types.Location import Development.IDE.GHC.Compat + +#if !MIN_VERSION_ghc(9,3,0) import GHC +#endif -- | The imports for a given module. newtype ModuleImports = ModuleImports From 0523bc8dbbe1fb7f11afb95f3ccb2115af91d3a1 Mon Sep 17 00:00:00 2001 From: Nathan Maxson Date: Wed, 16 Aug 2023 16:44:17 +0300 Subject: [PATCH 11/18] rewind some changes to fix test failures --- ghcide/src/Development/IDE/Core/Rules.hs | 82 ++++++++++++------------ 1 file changed, 42 insertions(+), 40 deletions(-) diff --git a/ghcide/src/Development/IDE/Core/Rules.hs b/ghcide/src/Development/IDE/Core/Rules.hs index 4ac2368664..7ac964bec3 100644 --- a/ghcide/src/Development/IDE/Core/Rules.hs +++ b/ghcide/src/Development/IDE/Core/Rules.hs @@ -334,10 +334,10 @@ getParsedModuleWithCommentsRule recorder = let ms' = withoutOption Opt_Haddock $ withOption Opt_KeepRawTokenStream ms modify_dflags <- getModifyDynFlags dynFlagsModifyParser - let ms'' = ms' { ms_hspp_opts = modify_dflags $ ms_hspp_opts ms' } + let ms = ms' { ms_hspp_opts = modify_dflags $ ms_hspp_opts ms' } reset_ms pm = pm { pm_mod_summary = ms' } - liftIO $ fmap (fmap reset_ms) $ snd <$> getParsedModuleDefinition hsc opt file ms'' + liftIO $ fmap (fmap reset_ms) $ snd <$> getParsedModuleDefinition hsc opt file ms getModifyDynFlags :: (DynFlagsModifications -> a) -> Action a getModifyDynFlags f = do @@ -370,7 +370,7 @@ getLocatedImportsRule recorder = let import_dirs = deps env_eq let dflags = hsc_dflags env isImplicitCradle = isNothing $ envImportPaths env_eq - dflags' <- return $ if isImplicitCradle + dflags <- return $ if isImplicitCradle then addRelativeImport file (moduleName $ ms_mod ms) dflags else dflags opt <- getIdeOptions @@ -391,7 +391,7 @@ getLocatedImportsRule recorder = | otherwise = return Nothing (diags, imports') <- fmap unzip $ forM imports $ \(isSource, (mbPkgName, modName)) -> do - diagOrImp <- locateModule (hscSetFlags dflags' env) import_dirs (optExtensions opt) getTargetFor modName mbPkgName isSource + diagOrImp <- locateModule (hscSetFlags dflags env) import_dirs (optExtensions opt) getTargetFor modName mbPkgName isSource case diagOrImp of Left diags -> pure (diags, Just (modName, Nothing)) Right (FileImport path) -> pure ([], Just (modName, Just path)) @@ -438,16 +438,16 @@ rawDependencyInformation fs = do go :: NormalizedFilePath -- ^ Current module being processed -> Maybe ModSummary -- ^ ModSummary of the module -> RawDepM FilePathId - go f mbMSum = do + go f msum = do -- First check to see if we have already processed the FilePath -- If we have, just return its Id but don't update any of the state. -- Otherwise, we need to process its imports. checkAlreadyProcessed f $ do - let al = modSummaryToArtifactsLocation f mbMSum + let al = modSummaryToArtifactsLocation f msum -- Get a fresh FilePathId for the new file fId <- getFreshFid al -- Record this module and its location - whenJust mbMSum $ \ms -> + whenJust msum $ \ms -> modifyRawDepInfo (\rd -> rd { rawModuleMap = IntMap.insert (getFilePathId fId) (ShowableModule $ ms_mod ms) (rawModuleMap rd)}) @@ -536,8 +536,9 @@ reportImportCyclesRule recorder = let cycles = mapMaybe (cycleErrorInFile fileId) (toList errs) -- Convert cycles of files into cycles of module names forM cycles $ \(imp, files) -> do - modNames <- forM files $ \filePathId -> - getModuleName $ idToPath depPathIdMap filePathId + modNames <- forM files $ \fileId -> do + let file = idToPath depPathIdMap fileId + getModuleName file pure $ toDiag imp $ sort modNames where cycleErrorInFile f (PartOfCycle imp fs) | f `elem` fs = Just (imp, fs) @@ -594,8 +595,8 @@ getHieAstRuleDefinition f hsc tmr = do _ | Just asts <- masts -> do source <- getSourceFileSource f let exports = tcg_exports $ tmrTypechecked tmr - modSum = tmrModSummary tmr - liftIO $ writeAndIndexHieFile hsc se modSum f exports asts source + msum = tmrModSummary tmr + liftIO $ writeAndIndexHieFile hsc se msum f exports asts source _ -> pure [] let refmap = Compat.generateReferencesMap . Compat.getAsts <$> masts @@ -850,6 +851,7 @@ getModIfaceFromDiskRule recorder = defineEarlyCutoff (cmapWithPrio LogShake reco Just session -> do linkableType <- getLinkableType f ver <- use_ GetModificationTime f + ShakeExtras{ideNc} <- getShakeExtras let m_old = case old of Shake.Succeeded (Just old_version) v -> Just (v, old_version) Shake.Stale _ (Just old_version) v -> Just (v, old_version) @@ -886,12 +888,12 @@ getModIfaceFromDiskAndIndexRule recorder = -- GetModIfaceFromDisk should have written a `.hie` file, must check if it matches version in db let ms = hirModSummary x hie_loc = Compat.ml_hie_file $ ms_location ms - fingerPrint <- liftIO $ Util.getFileHash hie_loc + hash <- liftIO $ Util.getFileHash hie_loc mrow <- liftIO $ withHieDb (\hieDb -> HieDb.lookupHieFileFromSource hieDb (fromNormalizedFilePath f)) hie_loc' <- liftIO $ traverse (makeAbsolute . HieDb.hieModuleHieFile) mrow case mrow of Just row - | fingerPrint == HieDb.modInfoHash (HieDb.hieModInfo row) + | hash == HieDb.modInfoHash (HieDb.hieModInfo row) && Just hie_loc == hie_loc' -> do -- All good, the db has indexed the file @@ -908,7 +910,7 @@ getModIfaceFromDiskAndIndexRule recorder = -- can just re-index the file we read from disk Right hf -> liftIO $ do logWith recorder Logger.Debug $ LogReindexingHieFile f - indexHieFile se ms f fingerPrint hf + indexHieFile se ms f hash hf return (Just x) @@ -955,14 +957,14 @@ getModSummaryRule displayTHWarning recorder = do ms <- use GetModSummary f case ms of Just res@ModSummaryResult{..} -> do - let modSum = msrModSummary { + let ms = msrModSummary { #if !MIN_VERSION_ghc(9,3,0) ms_hs_date = error "use GetModSummary instead of GetModSummaryWithoutTimestamps", #endif ms_hspp_buf = error "use GetModSummary instead of GetModSummaryWithoutTimestamps" } fp = fingerprintToBS msrFingerprint - return (Just fp, Just res{msrModSummary = modSum}) + return (Just fp, Just res{msrModSummary = ms}) Nothing -> return (Nothing, Nothing) generateCore :: RunSimplifier -> NormalizedFilePath -> Action (IdeResult ModGuts) @@ -979,7 +981,7 @@ generateCoreRule recorder = getModIfaceRule :: Recorder (WithPriority Log) -> Rules () getModIfaceRule recorder = defineEarlyCutoff (cmapWithPrio LogShake recorder) $ Rule $ \GetModIface f -> do fileOfInterest <- use_ IsFileOfInterest f - res <- case fileOfInterest of + res@(_,(_,mhmi)) <- case fileOfInterest of IsFOI status -> do -- Never load from disk for files of interest tmr <- use_ TypeCheck f @@ -987,14 +989,14 @@ getModIfaceRule recorder = defineEarlyCutoff (cmapWithPrio LogShake recorder) $ hsc <- hscEnv <$> use_ GhcSessionDeps f let compile = fmap ([],) $ use GenerateCore f se <- getShakeExtras - (diags, !mbHiFile) <- writeCoreFileIfNeeded se hsc linkableType compile tmr - let fp = hiFileFingerPrint <$> mbHiFile - hiDiags <- case mbHiFile of + (diags, !hiFile) <- writeCoreFileIfNeeded se hsc linkableType compile tmr + let fp = hiFileFingerPrint <$> hiFile + hiDiags <- case hiFile of Just hiFile | OnDisk <- status , not (tmrDeferredError tmr) -> liftIO $ writeHiFile se hsc hiFile _ -> pure [] - return (fp, (diags++hiDiags, mbHiFile)) + return (fp, (diags++hiDiags, hiFile)) NotFOI -> do hiFile <- use GetModIfaceFromDiskAndIndex f let fp = hiFileFingerPrint <$> hiFile @@ -1026,22 +1028,22 @@ regenerateHiFile sess f ms compNeeded = do -- Embed haddocks in the interface file (diags, mb_pm) <- liftIO $ getParsedModuleDefinition hsc opt f (withOptHaddock ms) - (diags', mb_pm') <- + (diags, mb_pm) <- -- We no longer need to parse again if GHC version is above 9.0. https://github.com/haskell/haskell-language-server/issues/1892 if Compat.ghcVersion >= Compat.GHC90 || isJust mb_pm then do return (diags, mb_pm) else do -- if parsing fails, try parsing again with Haddock turned off - (diagsNoHaddock, mb_pm'') <- liftIO $ getParsedModuleDefinition hsc opt f ms - return (mergeParseErrorsHaddock diagsNoHaddock diags, mb_pm'') - case mb_pm' of - Nothing -> return (diags', Nothing) + (diagsNoHaddock, mb_pm) <- liftIO $ getParsedModuleDefinition hsc opt f ms + return (mergeParseErrorsHaddock diagsNoHaddock diags, mb_pm) + case mb_pm of + Nothing -> return (diags, Nothing) Just pm -> do -- Invoke typechecking directly to update it without incurring a dependency -- on the parsed module and the typecheck rules - (diags'', mtmr) <- typeCheckRuleDefinition hsc pm + (diags', mtmr) <- typeCheckRuleDefinition hsc pm case mtmr of - Nothing -> pure (diags'', Nothing) + Nothing -> pure (diags', Nothing) Just tmr -> do let compile = liftIO $ compileModule (RunSimplifier True) hsc (pm_mod_summary pm) $ tmrTypechecked tmr @@ -1049,7 +1051,7 @@ regenerateHiFile sess f ms compNeeded = do se <- getShakeExtras -- Bang pattern is important to avoid leaking 'tmr' - (diags''', !res) <- writeCoreFileIfNeeded se hsc compNeeded compile tmr + (diags'', !res) <- writeCoreFileIfNeeded se hsc compNeeded compile tmr -- Write hi file hiDiags <- case res of @@ -1058,22 +1060,22 @@ regenerateHiFile sess f ms compNeeded = do -- Write hie file. Do this before writing the .hi file to -- ensure that we always have a up2date .hie file if we have -- a .hi file - se' <- getShakeExtras + se <- getShakeExtras (gDiags, masts) <- liftIO $ generateHieAsts hsc tmr source <- getSourceFileSource f wDiags <- forM masts $ \asts -> - liftIO $ writeAndIndexHieFile hsc se' (tmrModSummary tmr) f (tcg_exports $ tmrTypechecked tmr) asts source + liftIO $ writeAndIndexHieFile hsc se (tmrModSummary tmr) f (tcg_exports $ tmrTypechecked tmr) asts source -- We don't write the `.hi` file if there are deferred errors, since we won't get -- accurate diagnostics next time if we do hiDiags <- if not $ tmrDeferredError tmr - then liftIO $ writeHiFile se' hsc hiFile + then liftIO $ writeHiFile se hsc hiFile else pure [] pure (hiDiags <> gDiags <> concat wDiags) Nothing -> pure [] - return (diags''' <> diags''' <> diags''' <> hiDiags, res) + return (diags <> diags' <> diags'' <> hiDiags, res) -- | HscEnv should have deps included already @@ -1123,8 +1125,10 @@ getLinkableRule recorder = core_t <- liftIO $ getModTime core_file case hirCoreFp of Nothing -> error "called GetLinkable for a file without a linkable" - Just (bin_core, cfHash) -> do + Just (bin_core, hash) -> do session <- use_ GhcSessionDeps f + ShakeExtras{ideNc} <- getShakeExtras + let namecache_updater = mkUpdater ideNc linkableType <- getLinkableType f >>= \case Nothing -> error "called GetLinkable for a file which doesn't need compilation" Just t -> pure t @@ -1160,9 +1164,9 @@ getLinkableRule recorder = --just before returning it to be loaded. This has a substantial effect on recompile --times as the number of loaded modules and splices increases. -- - unload (hscEnv session) (map (\(mod', time') -> LM time' mod' []) $ moduleEnvToList to_keep) + unload (hscEnv session) (map (\(mod, time) -> LM time mod []) $ moduleEnvToList to_keep) return (to_keep, ()) - return (cfHash <$ hmi, (warns, LinkableResult <$> hmi <*> pure cfHash)) + return (hash <$ hmi, (warns, LinkableResult <$> hmi <*> pure hash)) -- | For now we always use bytecode unless something uses unboxed sums and tuples along with TH getLinkableType :: NormalizedFilePath -> Action (Maybe LinkableType) @@ -1215,18 +1219,16 @@ uses_th_qq (ms_hspp_opts -> dflags) = -- (assuming we do in fact need to compile it). -- Depends on whether it uses unboxed tuples or sums computeLinkableTypeForDynFlags :: DynFlags -> LinkableType +computeLinkableTypeForDynFlags d #if defined(GHC_PATCHED_UNBOXED_BYTECODE) || MIN_VERSION_ghc(9,2,0) -computeLinkableTypeForDynFlags _ = BCOLinkable #else -computeLinkableTypeForDynFlags d | unboxed_tuples_or_sums = ObjectLinkable | otherwise = BCOLinkable +#endif where unboxed_tuples_or_sums = xopt LangExt.UnboxedTuples d || xopt LangExt.UnboxedSums d -#endif - -- | Tracks which linkables are current, so we don't need to unload them newtype CompiledLinkables = CompiledLinkables { getCompiledLinkables :: Var (ModuleEnv UTCTime) } From 9873f429a1fc1508843f98a8a17fbe97746aef5f Mon Sep 17 00:00:00 2001 From: Nathan Maxson Date: Thu, 17 Aug 2023 15:20:27 +0300 Subject: [PATCH 12/18] fix flags --- ghcide/ghcide.cabal | 5 +- ghcide/src/Development/IDE/Core/Rules.hs | 73 ++++++++++++------------ ghcide/src/Development/IDE/GHC/Compat.hs | 1 + 3 files changed, 41 insertions(+), 38 deletions(-) diff --git a/ghcide/ghcide.cabal b/ghcide/ghcide.cabal index fee37df4da..1a292f7573 100644 --- a/ghcide/ghcide.cabal +++ b/ghcide/ghcide.cabal @@ -245,8 +245,11 @@ library -Wwarn=unused-local-binds -Wwarn=orphans -Wwarn=unused-matches - -Wwarn=ambiguous-fields -Wwarn=overlapping-patterns + -Wwarn=incomplete-record-updates + + if impl(ghc >= 9) && flag(pedantic) + ghc-options: -Wwarn=ambiguous-fields if impl(ghc >= 9) ghc-options: -Wunused-packages diff --git a/ghcide/src/Development/IDE/Core/Rules.hs b/ghcide/src/Development/IDE/Core/Rules.hs index 7ac964bec3..c45e86e354 100644 --- a/ghcide/src/Development/IDE/Core/Rules.hs +++ b/ghcide/src/Development/IDE/Core/Rules.hs @@ -68,9 +68,9 @@ import Control.Concurrent.Strict import Control.DeepSeq import Control.Exception.Safe import Control.Exception (evaluate) -import Control.Monad.Extra -import Control.Monad.Reader -import Control.Monad.State +import Control.Monad.Extra hiding (msum) +import Control.Monad.Reader hiding (msum) +import Control.Monad.State hiding (msum) import Control.Monad.Trans.Except (ExceptT, except, runExceptT) import Control.Monad.Trans.Maybe @@ -79,7 +79,7 @@ import qualified Data.Binary as B import qualified Data.ByteString as BS import qualified Data.ByteString.Lazy as LBS import Data.Coerce -import Data.Foldable +import Data.Foldable hiding (msum) import qualified Data.HashMap.Strict as HM import qualified Data.HashSet as HashSet import Data.Hashable @@ -334,10 +334,10 @@ getParsedModuleWithCommentsRule recorder = let ms' = withoutOption Opt_Haddock $ withOption Opt_KeepRawTokenStream ms modify_dflags <- getModifyDynFlags dynFlagsModifyParser - let ms = ms' { ms_hspp_opts = modify_dflags $ ms_hspp_opts ms' } + let ms'' = ms' { ms_hspp_opts = modify_dflags $ ms_hspp_opts ms' } reset_ms pm = pm { pm_mod_summary = ms' } - liftIO $ fmap (fmap reset_ms) $ snd <$> getParsedModuleDefinition hsc opt file ms + liftIO $ fmap (fmap reset_ms) $ snd <$> getParsedModuleDefinition hsc opt file ms'' getModifyDynFlags :: (DynFlagsModifications -> a) -> Action a getModifyDynFlags f = do @@ -370,7 +370,7 @@ getLocatedImportsRule recorder = let import_dirs = deps env_eq let dflags = hsc_dflags env isImplicitCradle = isNothing $ envImportPaths env_eq - dflags <- return $ if isImplicitCradle + dflags' <- return $ if isImplicitCradle then addRelativeImport file (moduleName $ ms_mod ms) dflags else dflags opt <- getIdeOptions @@ -391,7 +391,7 @@ getLocatedImportsRule recorder = | otherwise = return Nothing (diags, imports') <- fmap unzip $ forM imports $ \(isSource, (mbPkgName, modName)) -> do - diagOrImp <- locateModule (hscSetFlags dflags env) import_dirs (optExtensions opt) getTargetFor modName mbPkgName isSource + diagOrImp <- locateModule (hscSetFlags dflags' env) import_dirs (optExtensions opt) getTargetFor modName mbPkgName isSource case diagOrImp of Left diags -> pure (diags, Just (modName, Nothing)) Right (FileImport path) -> pure ([], Just (modName, Just path)) @@ -405,7 +405,7 @@ getLocatedImportsRule recorder = bootArtifact <- if boot == Just True then do let modName = ms_mod_name ms - loc <- liftIO $ mkHomeModLocation dflags modName (fromNormalizedFilePath bootPath) + loc <- liftIO $ mkHomeModLocation dflags' modName (fromNormalizedFilePath bootPath) return $ Just (noLoc modName, Just (ArtifactsLocation bootPath (Just loc) True)) else pure Nothing -} @@ -536,9 +536,8 @@ reportImportCyclesRule recorder = let cycles = mapMaybe (cycleErrorInFile fileId) (toList errs) -- Convert cycles of files into cycles of module names forM cycles $ \(imp, files) -> do - modNames <- forM files $ \fileId -> do - let file = idToPath depPathIdMap fileId - getModuleName file + modNames <- forM files $ + getModuleName . idToPath depPathIdMap pure $ toDiag imp $ sort modNames where cycleErrorInFile f (PartOfCycle imp fs) | f `elem` fs = Just (imp, fs) @@ -888,12 +887,12 @@ getModIfaceFromDiskAndIndexRule recorder = -- GetModIfaceFromDisk should have written a `.hie` file, must check if it matches version in db let ms = hirModSummary x hie_loc = Compat.ml_hie_file $ ms_location ms - hash <- liftIO $ Util.getFileHash hie_loc + fileHash <- liftIO $ Util.getFileHash hie_loc mrow <- liftIO $ withHieDb (\hieDb -> HieDb.lookupHieFileFromSource hieDb (fromNormalizedFilePath f)) hie_loc' <- liftIO $ traverse (makeAbsolute . HieDb.hieModuleHieFile) mrow case mrow of Just row - | hash == HieDb.modInfoHash (HieDb.hieModInfo row) + | fileHash == HieDb.modInfoHash (HieDb.hieModInfo row) && Just hie_loc == hie_loc' -> do -- All good, the db has indexed the file @@ -910,7 +909,7 @@ getModIfaceFromDiskAndIndexRule recorder = -- can just re-index the file we read from disk Right hf -> liftIO $ do logWith recorder Logger.Debug $ LogReindexingHieFile f - indexHieFile se ms f hash hf + indexHieFile se ms f fileHash hf return (Just x) @@ -954,8 +953,8 @@ getModSummaryRule displayTHWarning recorder = do Left diags -> return (Nothing, (diags, Nothing)) defineEarlyCutoff (cmapWithPrio LogShake recorder) $ RuleNoDiagnostics $ \GetModSummaryWithoutTimestamps f -> do - ms <- use GetModSummary f - case ms of + mbMs <- use GetModSummary f + case mbMs of Just res@ModSummaryResult{..} -> do let ms = msrModSummary { #if !MIN_VERSION_ghc(9,3,0) @@ -981,7 +980,7 @@ generateCoreRule recorder = getModIfaceRule :: Recorder (WithPriority Log) -> Rules () getModIfaceRule recorder = defineEarlyCutoff (cmapWithPrio LogShake recorder) $ Rule $ \GetModIface f -> do fileOfInterest <- use_ IsFileOfInterest f - res@(_,(_,mhmi)) <- case fileOfInterest of + res <- case fileOfInterest of IsFOI status -> do -- Never load from disk for files of interest tmr <- use_ TypeCheck f @@ -989,14 +988,14 @@ getModIfaceRule recorder = defineEarlyCutoff (cmapWithPrio LogShake recorder) $ hsc <- hscEnv <$> use_ GhcSessionDeps f let compile = fmap ([],) $ use GenerateCore f se <- getShakeExtras - (diags, !hiFile) <- writeCoreFileIfNeeded se hsc linkableType compile tmr - let fp = hiFileFingerPrint <$> hiFile - hiDiags <- case hiFile of + (diags, !mbHiFile) <- writeCoreFileIfNeeded se hsc linkableType compile tmr + let fp = hiFileFingerPrint <$> mbHiFile + hiDiags <- case mbHiFile of Just hiFile | OnDisk <- status , not (tmrDeferredError tmr) -> liftIO $ writeHiFile se hsc hiFile _ -> pure [] - return (fp, (diags++hiDiags, hiFile)) + return (fp, (diags++hiDiags, mbHiFile)) NotFOI -> do hiFile <- use GetModIfaceFromDiskAndIndex f let fp = hiFileFingerPrint <$> hiFile @@ -1028,22 +1027,22 @@ regenerateHiFile sess f ms compNeeded = do -- Embed haddocks in the interface file (diags, mb_pm) <- liftIO $ getParsedModuleDefinition hsc opt f (withOptHaddock ms) - (diags, mb_pm) <- + (diags', mb_pm') <- -- We no longer need to parse again if GHC version is above 9.0. https://github.com/haskell/haskell-language-server/issues/1892 if Compat.ghcVersion >= Compat.GHC90 || isJust mb_pm then do return (diags, mb_pm) else do -- if parsing fails, try parsing again with Haddock turned off - (diagsNoHaddock, mb_pm) <- liftIO $ getParsedModuleDefinition hsc opt f ms - return (mergeParseErrorsHaddock diagsNoHaddock diags, mb_pm) - case mb_pm of - Nothing -> return (diags, Nothing) + (diagsNoHaddock, mb_pm') <- liftIO $ getParsedModuleDefinition hsc opt f ms + return (mergeParseErrorsHaddock diagsNoHaddock diags, mb_pm') + case mb_pm' of + Nothing -> return (diags', Nothing) Just pm -> do -- Invoke typechecking directly to update it without incurring a dependency -- on the parsed module and the typecheck rules - (diags', mtmr) <- typeCheckRuleDefinition hsc pm + (diags'', mtmr) <- typeCheckRuleDefinition hsc pm case mtmr of - Nothing -> pure (diags', Nothing) + Nothing -> pure (diags'', Nothing) Just tmr -> do let compile = liftIO $ compileModule (RunSimplifier True) hsc (pm_mod_summary pm) $ tmrTypechecked tmr @@ -1051,7 +1050,7 @@ regenerateHiFile sess f ms compNeeded = do se <- getShakeExtras -- Bang pattern is important to avoid leaking 'tmr' - (diags'', !res) <- writeCoreFileIfNeeded se hsc compNeeded compile tmr + (diags''', !res) <- writeCoreFileIfNeeded se hsc compNeeded compile tmr -- Write hi file hiDiags <- case res of @@ -1060,22 +1059,22 @@ regenerateHiFile sess f ms compNeeded = do -- Write hie file. Do this before writing the .hi file to -- ensure that we always have a up2date .hie file if we have -- a .hi file - se <- getShakeExtras + se' <- getShakeExtras (gDiags, masts) <- liftIO $ generateHieAsts hsc tmr source <- getSourceFileSource f wDiags <- forM masts $ \asts -> - liftIO $ writeAndIndexHieFile hsc se (tmrModSummary tmr) f (tcg_exports $ tmrTypechecked tmr) asts source + liftIO $ writeAndIndexHieFile hsc se' (tmrModSummary tmr) f (tcg_exports $ tmrTypechecked tmr) asts source -- We don't write the `.hi` file if there are deferred errors, since we won't get -- accurate diagnostics next time if we do hiDiags <- if not $ tmrDeferredError tmr - then liftIO $ writeHiFile se hsc hiFile + then liftIO $ writeHiFile se' hsc hiFile else pure [] pure (hiDiags <> gDiags <> concat wDiags) Nothing -> pure [] - return (diags <> diags' <> diags'' <> hiDiags, res) + return (diags' <> diags'' <> diags''' <> hiDiags, res) -- | HscEnv should have deps included already @@ -1125,7 +1124,7 @@ getLinkableRule recorder = core_t <- liftIO $ getModTime core_file case hirCoreFp of Nothing -> error "called GetLinkable for a file without a linkable" - Just (bin_core, hash) -> do + Just (bin_core, fileHash) -> do session <- use_ GhcSessionDeps f ShakeExtras{ideNc} <- getShakeExtras let namecache_updater = mkUpdater ideNc @@ -1164,9 +1163,9 @@ getLinkableRule recorder = --just before returning it to be loaded. This has a substantial effect on recompile --times as the number of loaded modules and splices increases. -- - unload (hscEnv session) (map (\(mod, time) -> LM time mod []) $ moduleEnvToList to_keep) + unload (hscEnv session) (map (\(mod', time') -> LM time' mod' []) $ moduleEnvToList to_keep) return (to_keep, ()) - return (hash <$ hmi, (warns, LinkableResult <$> hmi <*> pure hash)) + return (fileHash <$ hmi, (warns, LinkableResult <$> hmi <*> pure fileHash)) -- | For now we always use bytecode unless something uses unboxed sums and tuples along with TH getLinkableType :: NormalizedFilePath -> Action (Maybe LinkableType) diff --git a/ghcide/src/Development/IDE/GHC/Compat.hs b/ghcide/src/Development/IDE/GHC/Compat.hs index ca4ab8d1d2..d73f1a8be0 100644 --- a/ghcide/src/Development/IDE/GHC/Compat.hs +++ b/ghcide/src/Development/IDE/GHC/Compat.hs @@ -142,6 +142,7 @@ module Development.IDE.GHC.Compat( #endif ) where +import Prelude hiding (mod) import Development.IDE.GHC.Compat.Core hiding (moduleUnitId) import Development.IDE.GHC.Compat.Env import Development.IDE.GHC.Compat.Iface From 4bee82e6e8a6e2ef2d2f558167f8ff9473b84f00 Mon Sep 17 00:00:00 2001 From: Nathan Maxson Date: Thu, 17 Aug 2023 15:43:22 +0300 Subject: [PATCH 13/18] fix flags --- ghcide/ghcide.cabal | 1 + 1 file changed, 1 insertion(+) diff --git a/ghcide/ghcide.cabal b/ghcide/ghcide.cabal index 1a292f7573..b908b91549 100644 --- a/ghcide/ghcide.cabal +++ b/ghcide/ghcide.cabal @@ -247,6 +247,7 @@ library -Wwarn=unused-matches -Wwarn=overlapping-patterns -Wwarn=incomplete-record-updates + -Wwarn=unticked-promoted-constructors if impl(ghc >= 9) && flag(pedantic) ghc-options: -Wwarn=ambiguous-fields From a9c9e2e7cfe23b4809322c153108b525661a8923 Mon Sep 17 00:00:00 2001 From: Nathan Maxson Date: Thu, 17 Aug 2023 18:34:29 +0300 Subject: [PATCH 14/18] fix unused-top-binds unused-local-binds orphans unused-matches and unticked-promoted-constructors --- ghcide/ghcide.cabal | 7 +--- .../session-loader/Development/IDE/Session.hs | 6 +-- ghcide/src/Development/IDE/Core/Compile.hs | 38 ++++++++++--------- ghcide/src/Development/IDE/Core/Rules.hs | 9 ++--- ghcide/src/Development/IDE/Core/Shake.hs | 3 -- ghcide/src/Development/IDE/Core/UseStale.hs | 6 +-- ghcide/src/Development/IDE/GHC/Compat/Core.hs | 4 +- ghcide/src/Development/IDE/GHC/Orphans.hs | 5 +++ .../src/Development/IDE/Import/FindImports.hs | 4 +- .../src/Development/IDE/LSP/LanguageServer.hs | 6 +-- ghcide/src/Development/IDE/LSP/Outline.hs | 8 ++-- ghcide/src/Development/IDE/LSP/Server.hs | 6 +-- ghcide/src/Development/IDE/Plugin/HLS.hs | 4 +- .../src/Development/IDE/Plugin/TypeLenses.hs | 4 +- ghcide/src/Development/IDE/Spans/AtPoint.hs | 4 +- .../Development/IDE/Spans/Documentation.hs | 8 ++-- hls-plugin-api/src/Ide/Types.hs | 3 ++ 17 files changed, 63 insertions(+), 62 deletions(-) diff --git a/ghcide/ghcide.cabal b/ghcide/ghcide.cabal index b908b91549..406850ff56 100644 --- a/ghcide/ghcide.cabal +++ b/ghcide/ghcide.cabal @@ -240,16 +240,11 @@ library -Wwarn=missing-signatures -Wwarn=duplicate-exports -Wwarn=dodgy-exports - -Wwarn=unused-top-binds -Wwarn=incomplete-patterns - -Wwarn=unused-local-binds - -Wwarn=orphans - -Wwarn=unused-matches -Wwarn=overlapping-patterns -Wwarn=incomplete-record-updates - -Wwarn=unticked-promoted-constructors - if impl(ghc >= 9) && flag(pedantic) + if impl(ghc >= 9.2) && flag(pedantic) ghc-options: -Wwarn=ambiguous-fields if impl(ghc >= 9) diff --git a/ghcide/session-loader/Development/IDE/Session.hs b/ghcide/session-loader/Development/IDE/Session.hs index 30d20c5234..c11068ae9a 100644 --- a/ghcide/session-loader/Development/IDE/Session.hs +++ b/ghcide/session-loader/Development/IDE/Session.hs @@ -530,7 +530,7 @@ loadSessionWithOptions recorder SessionLoadingOptions{..} dir = do #if MIN_VERSION_ghc(9,3,0) let (df2, uids) = (rawComponentDynFlags, []) #else - let (df2, uids) = removeInplacePackages fakeUid inplace rawComponentDynFlags + let (df2, uids) = _removeInplacePackages fakeUid inplace rawComponentDynFlags #endif let prefix = show rawComponentUnitId -- See Note [Avoiding bad interface files] @@ -1070,12 +1070,12 @@ getDependencyInfo fs = Map.fromList <$> mapM do_one fs -- There are several places in GHC (for example the call to hptInstances in -- tcRnImports) which assume that all modules in the HPT have the same unit -- ID. Therefore we create a fake one and give them all the same unit id. -removeInplacePackages +_removeInplacePackages --Only used in ghc < 9.4 :: UnitId -- ^ fake uid to use for our internal component -> [UnitId] -> DynFlags -> (DynFlags, [UnitId]) -removeInplacePackages fake_uid us df = (setHomeUnitId_ fake_uid $ +_removeInplacePackages fake_uid us df = (setHomeUnitId_ fake_uid $ df { packageFlags = ps }, uids) where (uids, ps) = Compat.filterInplaceUnits us (packageFlags df) diff --git a/ghcide/src/Development/IDE/Core/Compile.hs b/ghcide/src/Development/IDE/Core/Compile.hs index 9e6e762406..cd1a462a5d 100644 --- a/ghcide/src/Development/IDE/Core/Compile.hs +++ b/ghcide/src/Development/IDE/Core/Compile.hs @@ -856,9 +856,9 @@ generateHieAsts hscEnv tcm = where dflags = hsc_dflags hscEnv #if MIN_VERSION_ghc(9,0,0) - run ts = + run _ts = -- ts is only used in GHC 9.2 #if MIN_VERSION_ghc(9,2,0) && !MIN_VERSION_ghc(9,3,0) - fmap (join . snd) . liftIO . initDs hscEnv ts + fmap (join . snd) . liftIO . initDs hscEnv _ts #else id #endif @@ -1086,7 +1086,7 @@ mergeEnvs env mg ms extraMods envs = do -- Prefer non-boot files over non-boot files -- otherwise we can get errors like https://gitlab.haskell.org/ghc/ghc/-/issues/19816 -- if a boot file shadows over a non-boot file - combineModuleLocations a@(InstalledFound ml m) b | Just fp <- ml_hs_file ml, not ("boot" `isSuffixOf` fp) = a + combineModuleLocations a@(InstalledFound ml _) _ | Just fp <- ml_hs_file ml, not ("boot" `isSuffixOf` fp) = a combineModuleLocations _ b = b concatFC :: FinderCacheState -> [FinderCache] -> IO FinderCache @@ -1135,9 +1135,10 @@ getModSummaryFromImports -> UTCTime -> Maybe Util.StringBuffer -> ExceptT [FileDiagnostic] IO ModSummaryResult -getModSummaryFromImports env fp modTime mContents = do - - (contents, opts, ppEnv, src_hash) <- preprocessor env fp mContents +-- modTime is only used in GHC < 9.4 +getModSummaryFromImports env fp _modTime mContents = do +-- src_hash is only used in GHC >= 9.4 + (contents, opts, ppEnv, _src_hash) <- preprocessor env fp mContents let dflags = hsc_dflags ppEnv @@ -1153,7 +1154,8 @@ getModSummaryFromImports env fp modTime mContents = do (src_idecls, ord_idecls) = partition ((== IsBoot) . ideclSource.unLoc) imps -- GHC.Prim doesn't exist physically, so don't go looking for it. - (ordinary_imps, ghc_prim_imports) + -- ghc_prim_imports is only used in GHC >= 9.4 + (ordinary_imps, _ghc_prim_imports) = partition ((/= moduleName gHC_PRIM) . unLoc . ideclName . unLoc) ord_idecls @@ -1177,7 +1179,7 @@ getModSummaryFromImports env fp modTime mContents = do rn_imps = fmap (\(pk, lmn@(L _ mn)) -> (rn_pkg_qual mn pk, lmn)) srcImports = rn_imps $ map convImport src_idecls textualImports = rn_imps $ map convImport (implicit_imports ++ ordinary_imps) - ghc_prim_import = not (null ghc_prim_imports) + ghc_prim_import = not (null _ghc_prim_imports) #else srcImports = map convImport src_idecls textualImports = map convImport (implicit_imports ++ ordinary_imps) @@ -1204,10 +1206,10 @@ getModSummaryFromImports env fp modTime mContents = do #if MIN_VERSION_ghc(9,3,0) , ms_dyn_obj_date = Nothing , ms_ghc_prim_import = ghc_prim_import - , ms_hs_hash = src_hash + , ms_hs_hash = _src_hash #else - , ms_hs_date = modTime + , ms_hs_date = _modTime #endif , ms_hsc_src = sourceType -- The contents are used by the GetModSummary rule @@ -1475,19 +1477,21 @@ loadInterface session ms linkableNeeded RecompilationInfo{..} = do -- The source is modified if it is newer than the destination (iface file) -- A more precise check for the core file is performed later - let sourceMod = case mb_dest_version of + let _sourceMod = case mb_dest_version of -- sourceMod is only used in GHC < 9.4 Nothing -> SourceModified -- destination file doesn't exist, assume modified source Just dest_version | source_version <= dest_version -> SourceUnmodified | otherwise -> SourceModified - old_iface <- case mb_old_iface of + -- old_iface is only used in GHC >= 9.4 + _old_iface <- case mb_old_iface of Just iface -> pure (Just iface) Nothing -> do - let ncu = hsc_NC sessionWithMsDynFlags - read_dflags = hsc_dflags sessionWithMsDynFlags + -- ncu and read_dflags are only used in GHC >= 9.4 + let _ncu = hsc_NC sessionWithMsDynFlags + _read_dflags = hsc_dflags sessionWithMsDynFlags #if MIN_VERSION_ghc(9,3,0) - read_result <- liftIO $ readIface read_dflags ncu mod iface_file + read_result <- liftIO $ readIface _read_dflags _ncu mod iface_file #else read_result <- liftIO $ initIfaceCheck (text "readIface") sessionWithMsDynFlags $ readIface mod iface_file @@ -1502,11 +1506,11 @@ loadInterface session ms linkableNeeded RecompilationInfo{..} = do -- given that the source is unmodified (recomp_iface_reqd, mb_checked_iface) #if MIN_VERSION_ghc(9,3,0) - <- liftIO $ checkOldIface sessionWithMsDynFlags ms old_iface >>= \case + <- liftIO $ checkOldIface sessionWithMsDynFlags ms _old_iface >>= \case UpToDateItem x -> pure (UpToDate, Just x) OutOfDateItem reason x -> pure (NeedsRecompile reason, x) #else - <- liftIO $ checkOldIface sessionWithMsDynFlags ms sourceMod mb_old_iface + <- liftIO $ checkOldIface sessionWithMsDynFlags ms _sourceMod mb_old_iface #endif let do_regenerate _reason = withTrace "regenerate interface" $ \setTag -> do diff --git a/ghcide/src/Development/IDE/Core/Rules.hs b/ghcide/src/Development/IDE/Core/Rules.hs index c45e86e354..850c918b0f 100644 --- a/ghcide/src/Development/IDE/Core/Rules.hs +++ b/ghcide/src/Development/IDE/Core/Rules.hs @@ -850,7 +850,6 @@ getModIfaceFromDiskRule recorder = defineEarlyCutoff (cmapWithPrio LogShake reco Just session -> do linkableType <- getLinkableType f ver <- use_ GetModificationTime f - ShakeExtras{ideNc} <- getShakeExtras let m_old = case old of Shake.Succeeded (Just old_version) v -> Just (v, old_version) Shake.Stale _ (Just old_version) v -> Just (v, old_version) @@ -1126,8 +1125,6 @@ getLinkableRule recorder = Nothing -> error "called GetLinkable for a file without a linkable" Just (bin_core, fileHash) -> do session <- use_ GhcSessionDeps f - ShakeExtras{ideNc} <- getShakeExtras - let namecache_updater = mkUpdater ideNc linkableType <- getLinkableType f >>= \case Nothing -> error "called GetLinkable for a file which doesn't need compilation" Just t -> pure t @@ -1222,11 +1219,11 @@ computeLinkableTypeForDynFlags d #if defined(GHC_PATCHED_UNBOXED_BYTECODE) || MIN_VERSION_ghc(9,2,0) = BCOLinkable #else - | unboxed_tuples_or_sums = ObjectLinkable + | _unboxed_tuples_or_sums = ObjectLinkable | otherwise = BCOLinkable #endif - where - unboxed_tuples_or_sums = + where -- unboxed_tuples_or_sums is only used in GHC < 9.2 + _unboxed_tuples_or_sums = xopt LangExt.UnboxedTuples d || xopt LangExt.UnboxedSums d -- | Tracks which linkables are current, so we don't need to unload them diff --git a/ghcide/src/Development/IDE/Core/Shake.hs b/ghcide/src/Development/IDE/Core/Shake.hs index fb26bbe92e..fc5de72a6e 100644 --- a/ghcide/src/Development/IDE/Core/Shake.hs +++ b/ghcide/src/Development/IDE/Core/Shake.hs @@ -994,9 +994,6 @@ usesWithStale_ key files = do newtype IdeAction a = IdeAction { runIdeActionT :: (ReaderT ShakeExtras IO) a } 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 diff --git a/ghcide/src/Development/IDE/Core/UseStale.hs b/ghcide/src/Development/IDE/Core/UseStale.hs index ab6a0afa48..9aea6b7981 100644 --- a/ghcide/src/Development/IDE/Core/UseStale.hs +++ b/ghcide/src/Development/IDE/Core/UseStale.hs @@ -82,8 +82,8 @@ dualPositionMap (PositionMap (P.PositionMapping (P.PositionDelta from to))) = -- a 'PositionMapping' that will fast-forward values to the current age. data TrackedStale a where TrackedStale - :: Tracked (Stale s) a - -> PositionMap (Stale s) Current + :: Tracked ('Stale s) a + -> PositionMap ('Stale s) 'Current -> TrackedStale a instance Functor TrackedStale where @@ -136,7 +136,7 @@ unsafeMkCurrent :: age -> Tracked 'Current age unsafeMkCurrent = coerce -unsafeMkStale :: age -> Tracked (Stale s) age +unsafeMkStale :: age -> Tracked ('Stale s) age unsafeMkStale = coerce diff --git a/ghcide/src/Development/IDE/GHC/Compat/Core.hs b/ghcide/src/Development/IDE/GHC/Compat/Core.hs index 1e7f9043a8..64a4b6b0bf 100644 --- a/ghcide/src/Development/IDE/GHC/Compat/Core.hs +++ b/ghcide/src/Development/IDE/GHC/Compat/Core.hs @@ -1084,10 +1084,10 @@ makeSimpleDetails hsc_env = hsc_env #endif -mkIfaceTc hsc_env sf details ms tcGblEnv = +mkIfaceTc hsc_env sf details _ms tcGblEnv = -- ms is only used in GHC >= 9.4 GHC.mkIfaceTc hsc_env sf details #if MIN_VERSION_ghc(9,3,0) - ms + _ms #endif tcGblEnv diff --git a/ghcide/src/Development/IDE/GHC/Orphans.hs b/ghcide/src/Development/IDE/GHC/Orphans.hs index 5e7832f58e..078a5fd62a 100644 --- a/ghcide/src/Development/IDE/GHC/Orphans.hs +++ b/ghcide/src/Development/IDE/GHC/Orphans.hs @@ -12,6 +12,7 @@ import Development.IDE.GHC.Compat import Development.IDE.GHC.Util import Control.DeepSeq +import Control.Monad.Trans.Reader (ReaderT (..)) import Data.Aeson import Data.Hashable import Data.String (IsString (fromString)) @@ -52,6 +53,10 @@ import GHC.Types.PkgQual import GHC.Unit.Home.ModInfo #endif +-- Orphan instance for Shake.hs +-- https://hub.darcs.net/ross/transformers/issue/86 +deriving instance (Semigroup (m a)) => Semigroup (ReaderT r m a) + -- Orphan instances for types from the GHC API. instance Show CoreModule where show = unpack . printOutputable instance NFData CoreModule where rnf = rwhnf diff --git a/ghcide/src/Development/IDE/Import/FindImports.hs b/ghcide/src/Development/IDE/Import/FindImports.hs index d3a6cb645b..73d33b0d2a 100644 --- a/ghcide/src/Development/IDE/Import/FindImports.hs +++ b/ghcide/src/Development/IDE/Import/FindImports.hs @@ -164,7 +164,7 @@ locateModule env comp_info exts targetFor modName mbPkgName isSource = do hpt_deps :: [UnitId] hpt_deps = homeUnitDepends units #else - import_paths' + _import_paths' #endif -- first try to find the module as a file. If we can't find it try to find it in the package @@ -172,7 +172,7 @@ locateModule env comp_info exts targetFor modName mbPkgName isSource = do -- Here the importPaths for the current modules are added to the front of the import paths from the other components. -- This is particularly important for Paths_* modules which get generated for every component but unless you use it in -- each component will end up being found in the wrong place and cause a multi-cradle match failure. - import_paths' = + _import_paths' = -- import_paths' is only used in GHC < 9.4 #if MIN_VERSION_ghc(9,3,0) import_paths #else diff --git a/ghcide/src/Development/IDE/LSP/LanguageServer.hs b/ghcide/src/Development/IDE/LSP/LanguageServer.hs index 51ed44f17f..7e6b0a9c55 100644 --- a/ghcide/src/Development/IDE/LSP/LanguageServer.hs +++ b/ghcide/src/Development/IDE/LSP/LanguageServer.hs @@ -91,7 +91,7 @@ runLanguageServer -> config -> (config -> Value -> Either T.Text config) -> (MVar () - -> IO (LSP.LanguageContextEnv config -> TRequestMessage Method_Initialize -> IO (Either ResponseError (LSP.LanguageContextEnv config, a)), + -> IO (LSP.LanguageContextEnv config -> TRequestMessage 'Method_Initialize -> IO (Either ResponseError (LSP.LanguageContextEnv config, a)), LSP.Handlers (m config), (LanguageContextEnv config, a) -> m config <~> IO)) -> IO () @@ -132,7 +132,7 @@ setupLSP :: -> LSP.Handlers (ServerM config) -> (LSP.LanguageContextEnv config -> Maybe FilePath -> WithHieDb -> IndexQueue -> IO IdeState) -> MVar () - -> IO (LSP.LanguageContextEnv config -> TRequestMessage Method_Initialize -> IO (Either err (LSP.LanguageContextEnv config, IdeState)), + -> IO (LSP.LanguageContextEnv config -> TRequestMessage 'Method_Initialize -> IO (Either err (LSP.LanguageContextEnv config, IdeState)), LSP.Handlers (ServerM config), (LanguageContextEnv config, IdeState) -> ServerM config <~> IO) setupLSP recorder getHieDbLoc userHandlers getIdeState clientMsgVar = do @@ -194,7 +194,7 @@ handleInit -> (SomeLspId -> IO ()) -> (SomeLspId -> IO ()) -> Chan ReactorMessage - -> LSP.LanguageContextEnv config -> TRequestMessage Method_Initialize -> IO (Either err (LSP.LanguageContextEnv config, IdeState)) + -> LSP.LanguageContextEnv config -> TRequestMessage 'Method_Initialize -> IO (Either err (LSP.LanguageContextEnv config, IdeState)) handleInit recorder getHieDbLoc getIdeState lifetime exitClientMsg clearReqId waitForCancel clientMsgChan env (TRequestMessage _ _ m params) = otTracedHandler "Initialize" (show m) $ \sp -> do traceWithSpan sp params let root = LSP.resRootPath env diff --git a/ghcide/src/Development/IDE/LSP/Outline.hs b/ghcide/src/Development/IDE/LSP/Outline.hs index 4afc7c7dc1..5b88913a64 100644 --- a/ghcide/src/Development/IDE/LSP/Outline.hs +++ b/ghcide/src/Development/IDE/LSP/Outline.hs @@ -140,25 +140,25 @@ documentSymbolForDecl (L (locA -> (RealSrcSpan l _)) (TyClD _ DataDecl { tcdLNam } cvtFld _ = Nothing #else - [ (defDocumentSymbol l :: DocumentSymbol) + [ (defDocumentSymbol l'' :: DocumentSymbol) { _name = printOutputable n , _kind = SymbolKind_Constructor , _selectionRange = realSrcSpanToRange l' , _children = conArgRecordFields (con_args x) } - | L (locA -> (RealSrcSpan l _ )) x <- dd_cons + | L (locA -> (RealSrcSpan l'' _ )) x <- dd_cons , L (locA -> (RealSrcSpan l' _)) n <- getConNames' x ] } where -- | Extract the record fields of a constructor conArgRecordFields (RecCon (L _ lcdfs)) = Just - [ (defDocumentSymbol l :: DocumentSymbol) + [ (defDocumentSymbol l' :: DocumentSymbol) { _name = printOutputable n , _kind = SymbolKind_Field } | L _ cdf <- lcdfs - , L (locA -> (RealSrcSpan l _)) n <- rdrNameFieldOcc . unLoc <$> cd_fld_names cdf + , L (locA -> (RealSrcSpan l' _)) n <- rdrNameFieldOcc . unLoc <$> cd_fld_names cdf ] conArgRecordFields _ = Nothing #endif diff --git a/ghcide/src/Development/IDE/LSP/Server.hs b/ghcide/src/Development/IDE/LSP/Server.hs index bdfe407d5b..cebe7b3c60 100644 --- a/ghcide/src/Development/IDE/LSP/Server.hs +++ b/ghcide/src/Development/IDE/LSP/Server.hs @@ -14,7 +14,7 @@ import Control.Monad.IO.Unlift (MonadUnliftIO) import Control.Monad.Reader import Development.IDE.Core.Shake import Development.IDE.Core.Tracing -import Ide.Types (HasTracing, traceWithSpan) +import Ide.Types import Language.LSP.Protocol.Message import Language.LSP.Server (Handlers, LspM) import qualified Language.LSP.Server as LSP @@ -30,7 +30,7 @@ newtype ServerM c a = ServerM { unServerM :: ReaderT (ReactorChan, IdeState) (Ls deriving (Functor, Applicative, Monad, MonadReader (ReactorChan, IdeState), MonadIO, MonadUnliftIO, LSP.MonadLsp c) requestHandler - :: forall (m :: Method ClientToServer Request) c. (HasTracing (MessageParams m)) => + :: forall m c. PluginMethod 'Request m => SMethod m -> (IdeState -> MessageParams m -> LspM c (Either ResponseError (MessageResult m))) -> Handlers (ServerM c) @@ -45,7 +45,7 @@ requestHandler m k = LSP.requestHandler m $ \TRequestMessage{_method,_id,_params writeChan chan $ ReactorRequest (SomeLspId _id) (trace $ LSP.runLspT env $ resp' =<< k ide _params) (LSP.runLspT env . resp' . Left) notificationHandler - :: forall (m :: Method ClientToServer Notification) c. (HasTracing (MessageParams m)) => + :: forall m c. PluginMethod 'Notification m => SMethod m -> (IdeState -> VFS -> MessageParams m -> LspM c ()) -> Handlers (ServerM c) diff --git a/ghcide/src/Development/IDE/Plugin/HLS.hs b/ghcide/src/Development/IDE/Plugin/HLS.hs index b70d19e0f2..323a01e57d 100644 --- a/ghcide/src/Development/IDE/Plugin/HLS.hs +++ b/ghcide/src/Development/IDE/Plugin/HLS.hs @@ -329,11 +329,11 @@ logErrors recorder errs = do -- | Combine the 'PluginHandler' for all plugins -newtype IdeHandler (m :: Method ClientToServer Request) +newtype IdeHandler (m :: Method 'ClientToServer 'Request) = IdeHandler [(PluginId, PluginDescriptor IdeState, IdeState -> MessageParams m -> LSP.LspM Config (NonEmpty (Either PluginError (MessageResult m))))] -- | Combine the 'PluginHandler' for all plugins -newtype IdeNotificationHandler (m :: Method ClientToServer Notification) +newtype IdeNotificationHandler (m :: Method 'ClientToServer 'Notification) = IdeNotificationHandler [(PluginId, PluginDescriptor IdeState, IdeState -> VFS -> MessageParams m -> LSP.LspM Config ())] -- type NotificationHandler (m :: Method ClientToServer Notification) = MessageParams m -> IO ()` diff --git a/ghcide/src/Development/IDE/Plugin/TypeLenses.hs b/ghcide/src/Development/IDE/Plugin/TypeLenses.hs index cc77a33e27..9649daa50a 100644 --- a/ghcide/src/Development/IDE/Plugin/TypeLenses.hs +++ b/ghcide/src/Development/IDE/Plugin/TypeLenses.hs @@ -110,7 +110,7 @@ properties = emptyProperties , (Diagnostics, "Follows error messages produced by GHC about missing signatures") ] Always -codeLensProvider :: PluginMethodHandler IdeState Method_TextDocumentCodeLens +codeLensProvider :: PluginMethodHandler IdeState 'Method_TextDocumentCodeLens codeLensProvider ideState pId CodeLensParams{_textDocument = TextDocumentIdentifier uri} = do mode <- liftIO $ runAction "codeLens.config" ideState $ usePropertyAction #mode pId properties nfp <- getNormalizedFilePathE uri @@ -162,7 +162,7 @@ codeLensProvider ideState pId CodeLensParams{_textDocument = TextDocumentIdentif let allDiags = diags <> hDiags pure $ InL $ generateLensFromGlobalDiags allDiags -codeLensResolveProvider :: ResolveFunction IdeState TypeLensesResolve Method_CodeLensResolve +codeLensResolveProvider :: ResolveFunction IdeState TypeLensesResolve 'Method_CodeLensResolve codeLensResolveProvider ideState pId lens@CodeLens{_range} uri TypeLensesResolve = do nfp <- getNormalizedFilePathE uri (gblSigs@(GlobalBindingTypeSigsResult _), pm) <- diff --git a/ghcide/src/Development/IDE/Spans/AtPoint.hs b/ghcide/src/Development/IDE/Spans/AtPoint.hs index afd51f1f30..70a36693f8 100644 --- a/ghcide/src/Development/IDE/Spans/AtPoint.hs +++ b/ghcide/src/Development/IDE/Spans/AtPoint.hs @@ -245,9 +245,9 @@ atPoint IdeOptions{} (HAR _ hf _ _ (kind :: HieKind hietype)) (DKMap dm km) env -- Check for evidence bindings isInternal :: (Identifier, IdentifierDetails a) -> Bool - isInternal (Right _, dets) = + isInternal (Right _, _dets) = -- dets is only used in GHC >= 9.0.1 #if MIN_VERSION_ghc(9,0,1) - any isEvidenceContext $ identInfo dets + any isEvidenceContext $ identInfo _dets #else False #endif diff --git a/ghcide/src/Development/IDE/Spans/Documentation.hs b/ghcide/src/Development/IDE/Spans/Documentation.hs index 4bbe3018ac..72dbd52acb 100644 --- a/ghcide/src/Development/IDE/Spans/Documentation.hs +++ b/ghcide/src/Development/IDE/Spans/Documentation.hs @@ -121,6 +121,9 @@ getDocumentation => [ParsedModule] -- ^ All of the possible modules it could be defined in. -> name -- ^ The name you want documentation for. -> [T.Text] +#if MIN_VERSION_ghc(9,2,0) +getDocumentation _sources _targetName = [] +#else -- This finds any documentation between the name you want -- documentation for and the one before it. This is only an -- approximately correct algorithm and there are easily constructed @@ -131,10 +134,7 @@ getDocumentation -- TODO : Implement this for GHC 9.2 with in-tree annotations -- (alternatively, just remove it and rely solely on GHC's parsing) getDocumentation sources targetName = fromMaybe [] $ do -#if MIN_VERSION_ghc(9,2,0) - Nothing -#else - -- Find the module the target is defined in. + -- Find the module the target is defined in. targetNameSpan <- realSpan $ getLoc targetName tc <- find ((==) (Just $ srcSpanFile targetNameSpan) . annotationFileName) diff --git a/hls-plugin-api/src/Ide/Types.hs b/hls-plugin-api/src/Ide/Types.hs index cc36e6aa5d..ce7acc2ff5 100644 --- a/hls-plugin-api/src/Ide/Types.hs +++ b/hls-plugin-api/src/Ide/Types.hs @@ -531,6 +531,9 @@ instance PluginMethod Request Method_CallHierarchyOutgoingCalls where -- This method has no URI parameter, thus no call to 'pluginResponsible' pluginEnabled _ _ pluginDesc conf = pluginEnabledConfig plcCallHierarchyOn (configForPlugin conf pluginDesc) +instance PluginMethod Request Method_WorkspaceExecuteCommand where + pluginEnabled _ _ _ _= True + instance PluginMethod Request (Method_CustomMethod m) where pluginEnabled _ _ _ _ = True From 5b50bc166f6a2426d4beb35404b881f53d4ea08b Mon Sep 17 00:00:00 2001 From: Nathan Maxson Date: Thu, 17 Aug 2023 19:52:55 +0300 Subject: [PATCH 15/18] fix flags --- ghcide/src/Development/IDE/GHC/Compat/Parser.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/ghcide/src/Development/IDE/GHC/Compat/Parser.hs b/ghcide/src/Development/IDE/GHC/Compat/Parser.hs index 8b52608e4e..a98455e9dc 100644 --- a/ghcide/src/Development/IDE/GHC/Compat/Parser.hs +++ b/ghcide/src/Development/IDE/GHC/Compat/Parser.hs @@ -134,7 +134,7 @@ pattern HsParsedModule , hpm_annotations } <- ( (,()) -> (GHC.HsParsedModule{..}, hpm_annotations)) where - HsParsedModule hpm_module hpm_src_files hpm_annotations = + HsParsedModule hpm_module hpm_src_files _hpm_annotations = GHC.HsParsedModule hpm_module hpm_src_files #endif From cd6c5260fcc94608f911ed2ff8d0fb1bf11ba211 Mon Sep 17 00:00:00 2001 From: Nathan Maxson Date: Fri, 18 Aug 2023 14:56:16 +0300 Subject: [PATCH 16/18] fix flags --- ghcide/src/Development/IDE/Core/Compile.hs | 6 +++--- ghcide/src/Development/IDE/GHC/Compat/Plugins.hs | 9 +++++---- ghcide/src/Development/IDE/GHC/CoreFile.hs | 3 ++- 3 files changed, 10 insertions(+), 8 deletions(-) diff --git a/ghcide/src/Development/IDE/Core/Compile.hs b/ghcide/src/Development/IDE/Core/Compile.hs index cd1a462a5d..13c48e7123 100644 --- a/ghcide/src/Development/IDE/Core/Compile.hs +++ b/ghcide/src/Development/IDE/Core/Compile.hs @@ -1634,15 +1634,15 @@ coreFileToCgGuts session iface details core_file = do }) core_binds <- initIfaceCheck (text "l") hsc_env' $ typecheckCoreFile this_mod types_var core_file -- Implicit binds aren't saved, so we need to regenerate them ourselves. - let implicit_binds = concatMap getImplicitBinds tyCons + let _implicit_binds = concatMap getImplicitBinds tyCons -- only used if GHC < 9.6 tyCons = typeEnvTyCons (md_types details) #if MIN_VERSION_ghc(9,5,0) -- In GHC 9.6, the implicit binds are tidied and part of core_binds pure $ CgGuts this_mod tyCons core_binds [] NoStubs [] mempty (emptyHpcInfo False) Nothing [] #elif MIN_VERSION_ghc(9,3,0) - pure $ CgGuts this_mod tyCons (implicit_binds ++ core_binds) [] NoStubs [] mempty (emptyHpcInfo False) Nothing [] + 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 [] + pure $ CgGuts this_mod tyCons (_implicit_binds ++ core_binds) NoStubs [] [] (emptyHpcInfo False) Nothing [] #endif coreFileToLinkable :: LinkableType -> HscEnv -> ModSummary -> ModIface -> ModDetails -> CoreFile -> UTCTime -> IO ([FileDiagnostic], Maybe HomeModInfo) diff --git a/ghcide/src/Development/IDE/GHC/Compat/Plugins.hs b/ghcide/src/Development/IDE/GHC/Compat/Plugins.hs index faffcb48a8..30dbdf2d6d 100644 --- a/ghcide/src/Development/IDE/GHC/Compat/Plugins.hs +++ b/ghcide/src/Development/IDE/GHC/Compat/Plugins.hs @@ -66,7 +66,7 @@ type PsMessages = (Bag WarnMsg, Bag ErrMsg) #endif getPsMessages :: PState -> DynFlags -> PsMessages -getPsMessages pst dflags = +getPsMessages pst _dflags = --dfags is only used if GHC < 9.2 #if MIN_VERSION_ghc(9,3,0) uncurry PsMessages $ Lexer.getPsMessages pst #else @@ -75,12 +75,13 @@ getPsMessages pst dflags = #endif getMessages pst #if !MIN_VERSION_ghc(9,2,0) - dflags + _dflags #endif #endif applyPluginsParsedResultAction :: HscEnv -> DynFlags -> ModSummary -> Parser.ApiAnns -> ParsedSource -> PsMessages -> IO (ParsedSource, PsMessages) -applyPluginsParsedResultAction env dflags ms hpm_annotations parsed msgs = do +applyPluginsParsedResultAction env _dflags ms hpm_annotations parsed msgs = do + -- dflags is only used in GHC < 9.2 -- Apply parsedResultAction of plugins let applyPluginAction p opts = parsedResultAction p opts ms #if MIN_VERSION_ghc(9,3,0) @@ -93,7 +94,7 @@ applyPluginsParsedResultAction env dflags ms hpm_annotations parsed msgs = do #elif MIN_VERSION_ghc(9,2,0) env #else - dflags + _dflags #endif applyPluginAction #if MIN_VERSION_ghc(9,3,0) diff --git a/ghcide/src/Development/IDE/GHC/CoreFile.hs b/ghcide/src/Development/IDE/GHC/CoreFile.hs index efab2b17b1..35c5bd2591 100644 --- a/ghcide/src/Development/IDE/GHC/CoreFile.hs +++ b/ghcide/src/Development/IDE/GHC/CoreFile.hs @@ -141,7 +141,7 @@ codeGutsToCoreFile 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 @@ -150,6 +150,7 @@ isNotImplictBind bind = any (not . isImplicitId) $ bindBindings bind bindBindings :: CoreBind -> [Var] bindBindings (NonRec b _) = [b] bindBindings (Rec bnds) = map fst bnds +#endif getImplicitBinds :: TyCon -> [CoreBind] getImplicitBinds tc = cls_binds ++ getTyConImplicitBinds tc From 4a7bac5b0ea999eae565c98e7f652ecc6854dd08 Mon Sep 17 00:00:00 2001 From: Nathan Maxson Date: Fri, 18 Aug 2023 15:31:56 +0300 Subject: [PATCH 17/18] revert temporary flags workflow changes --- .github/workflows/flags.yml | 6 ++++-- 1 file changed, 4 insertions(+), 2 deletions(-) diff --git a/.github/workflows/flags.yml b/.github/workflows/flags.yml index fa894b0f61..f00af915f1 100644 --- a/.github/workflows/flags.yml +++ b/.github/workflows/flags.yml @@ -47,7 +47,7 @@ jobs: needs: pre_job runs-on: ${{ matrix.os }} strategy: - fail-fast: false + fail-fast: true matrix: ghc: ${{ fromJSON(needs.pre_job.outputs.ghcs) }} os: @@ -75,7 +75,9 @@ jobs: - name: Build `ghcide` with flags run: cabal v2-build ghcide --flags="ghc-patched-unboxed-bytecode test-exe executable bench-exe ekg" - - name: Build with pedantic (-WError) + # wingman fails with flags on 9.0, so this can be removed when that's gone + - if: matrix.ghc != '9.0' + name: Build with pedantic (-WError) run: cabal v2-build --flags="pedantic" flags_post_job: From e697bff4d29ab7814286614437dfa6c192ce9da9 Mon Sep 17 00:00:00 2001 From: Nathan Maxson Date: Tue, 22 Aug 2023 16:39:19 +0300 Subject: [PATCH 18/18] address michealpj and fendor's comments --- ghcide/ghcide.cabal | 7 +++++ .../session-loader/Development/IDE/Session.hs | 2 ++ ghcide/src/Development/IDE/Core/Compile.hs | 30 +++++++++++++++++++ ghcide/src/Development/IDE/Core/FileStore.hs | 5 ---- .../src/Development/IDE/Core/Preprocessor.hs | 2 ++ ghcide/src/Development/IDE/Core/Rules.hs | 2 ++ ghcide/src/Development/IDE/Core/Shake.hs | 2 ++ ghcide/src/Development/IDE/Core/UseStale.hs | 6 ++-- ghcide/src/Development/IDE/GHC/CPP.hs | 2 ++ ghcide/src/Development/IDE/GHC/Compat.hs | 2 ++ ghcide/src/Development/IDE/GHC/Compat/Core.hs | 2 ++ ghcide/src/Development/IDE/GHC/Compat/Env.hs | 2 ++ .../src/Development/IDE/GHC/Compat/Iface.hs | 2 ++ .../src/Development/IDE/GHC/Compat/Logger.hs | 2 ++ .../Development/IDE/GHC/Compat/Outputable.hs | 28 ++++++++--------- .../src/Development/IDE/GHC/Compat/Parser.hs | 2 ++ .../src/Development/IDE/GHC/Compat/Plugins.hs | 2 ++ .../src/Development/IDE/GHC/Compat/Units.hs | 2 ++ ghcide/src/Development/IDE/GHC/Compat/Util.hs | 2 ++ ghcide/src/Development/IDE/GHC/CoreFile.hs | 2 ++ ghcide/src/Development/IDE/GHC/Orphans.hs | 4 ++- ghcide/src/Development/IDE/GHC/Util.hs | 2 ++ .../IDE/Import/DependencyInformation.hs | 2 ++ .../src/Development/IDE/Import/FindImports.hs | 2 ++ .../Development/IDE/LSP/HoverDefinition.hs | 8 ++--- .../src/Development/IDE/LSP/LanguageServer.hs | 6 ++-- ghcide/src/Development/IDE/LSP/Outline.hs | 4 ++- ghcide/src/Development/IDE/LSP/Server.hs | 4 +-- .../src/Development/IDE/Plugin/Completions.hs | 6 ++-- .../IDE/Plugin/Completions/Logic.hs | 2 ++ .../IDE/Plugin/Completions/Types.hs | 6 ++-- ghcide/src/Development/IDE/Plugin/HLS.hs | 4 +-- .../src/Development/IDE/Plugin/HLS/GhcIde.hs | 2 +- .../src/Development/IDE/Plugin/TypeLenses.hs | 6 ++-- ghcide/src/Development/IDE/Types/Location.hs | 2 ++ 35 files changed, 123 insertions(+), 43 deletions(-) diff --git a/ghcide/ghcide.cabal b/ghcide/ghcide.cabal index 406850ff56..a0044d14d0 100644 --- a/ghcide/ghcide.cabal +++ b/ghcide/ghcide.cabal @@ -227,12 +227,16 @@ library ghc-options: -Wall -Wincomplete-uni-patterns + -Wno-unticked-promoted-constructors -fno-ignore-asserts if flag(ghc-patched-unboxed-bytecode) cpp-options: -DGHC_PATCHED_UNBOXED_BYTECODE if flag(pedantic) + -- We eventually want to build with Werror fully, but we haven't + -- finished purging the warnings, so some are set to not be errors + -- for now ghc-options: -Werror -Wwarn=unused-packages -Wwarn=unrecognised-pragmas @@ -244,6 +248,9 @@ library -Wwarn=overlapping-patterns -Wwarn=incomplete-record-updates + -- ambiguous-fields is only understood by GHC >= 9.2, so we only disable it + -- then. The above comment goes for here too -- this should be understood to + -- be temporary until we can remove these warnings. if impl(ghc >= 9.2) && flag(pedantic) ghc-options: -Wwarn=ambiguous-fields diff --git a/ghcide/session-loader/Development/IDE/Session.hs b/ghcide/session-loader/Development/IDE/Session.hs index c11068ae9a..6dfb9a7b01 100644 --- a/ghcide/session-loader/Development/IDE/Session.hs +++ b/ghcide/session-loader/Development/IDE/Session.hs @@ -110,6 +110,8 @@ import HieDb.Utils import qualified System.Random as Random import System.Random (RandomGen) +-- See Note [Guidelines For Using CPP In GHCIDE Import Statements] + #if !MIN_VERSION_ghc(9,4,0) import Data.IORef #endif diff --git a/ghcide/src/Development/IDE/Core/Compile.hs b/ghcide/src/Development/IDE/Core/Compile.hs index 13c48e7123..2b35563975 100644 --- a/ghcide/src/Development/IDE/Core/Compile.hs +++ b/ghcide/src/Development/IDE/Core/Compile.hs @@ -106,6 +106,7 @@ import System.Directory import System.FilePath import System.IO.Extra (fixIO, newTempFileWithin) +-- See Note [Guidelines For Using CPP In GHCIDE Import Statements] #if !MIN_VERSION_ghc(9,0,1) import HscTypes @@ -1745,3 +1746,32 @@ pathToModuleName = mkModuleName . map rep rep c | isPathSeparator c = '_' rep ':' = '_' rep c = c + +{- Note [Guidelines For Using CPP In GHCIDE Import Statements] + GHCIDE's interface with GHC is extensive, and unfortunately, because we have + to work with multiple versions of GHC, we have several files that need to use + a lot of CPP. In order to simplify the CPP in the import section of every file + we have a few specific guidelines for using CPP in these sections. + + - We don't want to nest CPP clauses, nor do we want to use else clauses. Both + nesting and else clauses end up drastically complicating the code, and require + significant mental stack to unwind. + + - CPP clauses should be placed at the end of the imports section. The clauses + should be ordered by the GHC version they target from earlier to later versions, + with negative if clauses coming before positive if clauses of the same + version. (If you think about which GHC version a clause activates for this + should make sense `!MIN_VERSION_GHC(9,0,0)` refers to 8.10 and lower which is + a earlier version than `MIN_VERSION_GHC(9,0,0)` which refers to versions 9.0 + and later). In addition there should be a space before and after each CPP + clause. + + - In if clauses that use `&&` and depend on more than one statement, the + positive statement should come before the negative statement. In addition the + clause should come after the single positive clause for that GHC version. + + - There shouldn't be multiple identical CPP statements. The use of odd or even + GHC numbers is identical, with the only preference being to use what is + already there. (i.e. (`MIN_VERSION_GHC(9,2,0)` and `MIN_VERSION_GHC(9,1,0)` + are functionally equivalent) +-} \ No newline at end of file diff --git a/ghcide/src/Development/IDE/Core/FileStore.hs b/ghcide/src/Development/IDE/Core/FileStore.hs index a780fda0b7..315a078282 100644 --- a/ghcide/src/Development/IDE/Core/FileStore.hs +++ b/ghcide/src/Development/IDE/Core/FileStore.hs @@ -1,6 +1,5 @@ -- Copyright (c) 2019 The DAML Authors. All rights reserved. -- SPDX-License-Identifier: Apache-2.0 -{-# LANGUAGE CPP #-} {-# LANGUAGE TypeFamilies #-} module Development.IDE.Core.FileStore( @@ -73,10 +72,6 @@ import System.FilePath import System.IO.Error import System.IO.Unsafe -#ifdef mingw32_HOST_OS -import qualified System.Directory as Dir -#else -#endif data Log = LogCouldNotIdentifyReverseDeps !NormalizedFilePath diff --git a/ghcide/src/Development/IDE/Core/Preprocessor.hs b/ghcide/src/Development/IDE/Core/Preprocessor.hs index 57bc1a12ed..24a754870d 100644 --- a/ghcide/src/Development/IDE/Core/Preprocessor.hs +++ b/ghcide/src/Development/IDE/Core/Preprocessor.hs @@ -31,6 +31,8 @@ import qualified GHC.LanguageExtensions as LangExt import System.FilePath import System.IO.Extra +-- See Note [Guidelines For Using CPP In GHCIDE Import Statements] + #if MIN_VERSION_ghc(9,3,0) import GHC.Utils.Logger (LogFlags (..)) #endif diff --git a/ghcide/src/Development/IDE/Core/Rules.hs b/ghcide/src/Development/IDE/Core/Rules.hs index 850c918b0f..1ce358fb88 100644 --- a/ghcide/src/Development/IDE/Core/Rules.hs +++ b/ghcide/src/Development/IDE/Core/Rules.hs @@ -161,6 +161,8 @@ import Control.Monad.IO.Unlift import GHC.Fingerprint +-- See Note [Guidelines For Using CPP In GHCIDE Import Statements] + #if !MIN_VERSION_ghc(9,3,0) import GHC (mgModSummaries) #endif diff --git a/ghcide/src/Development/IDE/Core/Shake.hs b/ghcide/src/Development/IDE/Core/Shake.hs index fc5de72a6e..c413729ab1 100644 --- a/ghcide/src/Development/IDE/Core/Shake.hs +++ b/ghcide/src/Development/IDE/Core/Shake.hs @@ -177,6 +177,8 @@ import System.FilePath hiding (makeRelative) import System.IO.Unsafe (unsafePerformIO) import System.Time.Extra +-- See Note [Guidelines For Using CPP In GHCIDE Import Statements] + #if !MIN_VERSION_ghc(9,3,0) import Data.IORef import Development.IDE.GHC.Compat (mkSplitUniqSupply, diff --git a/ghcide/src/Development/IDE/Core/UseStale.hs b/ghcide/src/Development/IDE/Core/UseStale.hs index 9aea6b7981..ab6a0afa48 100644 --- a/ghcide/src/Development/IDE/Core/UseStale.hs +++ b/ghcide/src/Development/IDE/Core/UseStale.hs @@ -82,8 +82,8 @@ dualPositionMap (PositionMap (P.PositionMapping (P.PositionDelta from to))) = -- a 'PositionMapping' that will fast-forward values to the current age. data TrackedStale a where TrackedStale - :: Tracked ('Stale s) a - -> PositionMap ('Stale s) 'Current + :: Tracked (Stale s) a + -> PositionMap (Stale s) Current -> TrackedStale a instance Functor TrackedStale where @@ -136,7 +136,7 @@ unsafeMkCurrent :: age -> Tracked 'Current age unsafeMkCurrent = coerce -unsafeMkStale :: age -> Tracked ('Stale s) age +unsafeMkStale :: age -> Tracked (Stale s) age unsafeMkStale = coerce diff --git a/ghcide/src/Development/IDE/GHC/CPP.hs b/ghcide/src/Development/IDE/GHC/CPP.hs index 00d6303134..87d25c7fa9 100644 --- a/ghcide/src/Development/IDE/GHC/CPP.hs +++ b/ghcide/src/Development/IDE/GHC/CPP.hs @@ -19,6 +19,8 @@ import Development.IDE.GHC.Compat as Compat import Development.IDE.GHC.Compat.Util import GHC +-- See Note [Guidelines For Using CPP In GHCIDE Import Statements] + #if MIN_VERSION_ghc (8,10,0) && !MIN_VERSION_ghc(9,0,0) import qualified DriverPipeline as Pipeline import ToolSettings diff --git a/ghcide/src/Development/IDE/GHC/Compat.hs b/ghcide/src/Development/IDE/GHC/Compat.hs index d73f1a8be0..3fade3a314 100644 --- a/ghcide/src/Development/IDE/GHC/Compat.hs +++ b/ghcide/src/Development/IDE/GHC/Compat.hs @@ -168,6 +168,8 @@ import Data.List (foldl') import qualified Data.Map as Map import qualified Data.Set as S +-- See Note [Guidelines For Using CPP In GHCIDE Import Statements] + #if !MIN_VERSION_ghc(9,0,0) import Annotations (AnnTarget (ModuleTarget), Annotation (..), diff --git a/ghcide/src/Development/IDE/GHC/Compat/Core.hs b/ghcide/src/Development/IDE/GHC/Compat/Core.hs index 64a4b6b0bf..b6067167e2 100644 --- a/ghcide/src/Development/IDE/GHC/Compat/Core.hs +++ b/ghcide/src/Development/IDE/GHC/Compat/Core.hs @@ -507,6 +507,8 @@ import GHC.LanguageExtensions.Type hiding (Cpp) import GHC.Hs.Binds +-- See Note [Guidelines For Using CPP In GHCIDE Import Statements] + #if !MIN_VERSION_ghc(9,0,0) import qualified Avail import BasicTypes hiding (Version) diff --git a/ghcide/src/Development/IDE/GHC/Compat/Env.hs b/ghcide/src/Development/IDE/GHC/Compat/Env.hs index 43bc4825e6..1cd9350945 100644 --- a/ghcide/src/Development/IDE/GHC/Compat/Env.hs +++ b/ghcide/src/Development/IDE/GHC/Compat/Env.hs @@ -55,6 +55,8 @@ module Development.IDE.GHC.Compat.Env ( import GHC (setInteractiveDynFlags) +-- See Note [Guidelines For Using CPP In GHCIDE Import Statements] + #if !MIN_VERSION_ghc(9,0,0) import DynFlags import Hooks diff --git a/ghcide/src/Development/IDE/GHC/Compat/Iface.hs b/ghcide/src/Development/IDE/GHC/Compat/Iface.hs index 0102818887..c9531469bc 100644 --- a/ghcide/src/Development/IDE/GHC/Compat/Iface.hs +++ b/ghcide/src/Development/IDE/GHC/Compat/Iface.hs @@ -10,6 +10,8 @@ import Development.IDE.GHC.Compat.Env import Development.IDE.GHC.Compat.Outputable import GHC +-- See Note [Guidelines For Using CPP In GHCIDE Import Statements] + #if !MIN_VERSION_ghc(9,0,0) import Finder (FindResult) import qualified Finder diff --git a/ghcide/src/Development/IDE/GHC/Compat/Logger.hs b/ghcide/src/Development/IDE/GHC/Compat/Logger.hs index 8e0137f57d..6c520dc2a7 100644 --- a/ghcide/src/Development/IDE/GHC/Compat/Logger.hs +++ b/ghcide/src/Development/IDE/GHC/Compat/Logger.hs @@ -13,6 +13,8 @@ import Development.IDE.GHC.Compat.Core import Development.IDE.GHC.Compat.Env as Env import Development.IDE.GHC.Compat.Outputable +-- See Note [Guidelines For Using CPP In GHCIDE Import Statements] + #if !MIN_VERSION_ghc(9,0,0) import DynFlags import Outputable (queryQual) diff --git a/ghcide/src/Development/IDE/GHC/Compat/Outputable.hs b/ghcide/src/Development/IDE/GHC/Compat/Outputable.hs index 6163c5dce4..c3d8fef64c 100644 --- a/ghcide/src/Development/IDE/GHC/Compat/Outputable.hs +++ b/ghcide/src/Development/IDE/GHC/Compat/Outputable.hs @@ -49,17 +49,7 @@ module Development.IDE.GHC.Compat.Outputable ( textDoc, ) where -#if MIN_VERSION_ghc(9,0,0) && !MIN_VERSION_ghc(9,2,0) -import GHC.Driver.Session -import GHC.Driver.Types as HscTypes -import GHC.Types.Name.Reader (GlobalRdrEnv) -import GHC.Types.SrcLoc -import GHC.Utils.Error as Err hiding (mkWarnMsg) -import qualified GHC.Utils.Error as Err -import GHC.Utils.Outputable as Out hiding - (defaultUserStyle) -import qualified GHC.Utils.Outputable as Out -#endif +-- See Note [Guidelines For Using CPP In GHCIDE Import Statements] #if !MIN_VERSION_ghc(9,0,0) import Development.IDE.GHC.Compat.Core (GlobalRdrEnv) @@ -73,6 +63,18 @@ import qualified Outputable as Out import SrcLoc #endif +#if MIN_VERSION_ghc(9,0,0) && !MIN_VERSION_ghc(9,2,0) +import GHC.Driver.Session +import GHC.Driver.Types as HscTypes +import GHC.Types.Name.Reader (GlobalRdrEnv) +import GHC.Types.SrcLoc +import GHC.Utils.Error as Err hiding (mkWarnMsg) +import qualified GHC.Utils.Error as Err +import GHC.Utils.Outputable as Out hiding + (defaultUserStyle) +import qualified GHC.Utils.Outputable as Out +#endif + #if MIN_VERSION_ghc(9,2,0) import GHC.Driver.Env import GHC.Driver.Ppr @@ -224,20 +226,18 @@ type ErrMsg = MsgEnvelope DecoratedSDoc type WarnMsg = MsgEnvelope DecoratedSDoc #endif -#if MIN_VERSION_ghc(9,5,0) mkPrintUnqualifiedDefault :: HscEnv -> GlobalRdrEnv -> PrintUnqualified +#if MIN_VERSION_ghc(9,5,0) mkPrintUnqualifiedDefault env = mkNamePprCtx ptc (hsc_unit_env env) where ptc = initPromotionTickContext (hsc_dflags env) #elif MIN_VERSION_ghc(9,2,0) -mkPrintUnqualifiedDefault :: HscEnv -> GlobalRdrEnv -> PrintUnqualified mkPrintUnqualifiedDefault env = -- GHC 9.2 version -- mkPrintUnqualified :: UnitEnv -> GlobalRdrEnv -> PrintUnqualified mkPrintUnqualified (hsc_unit_env env) #else -mkPrintUnqualifiedDefault :: HscEnv -> GlobalRdrEnv -> PrintUnqualified mkPrintUnqualifiedDefault env = HscTypes.mkPrintUnqualified (hsc_dflags env) #endif diff --git a/ghcide/src/Development/IDE/GHC/Compat/Parser.hs b/ghcide/src/Development/IDE/GHC/Compat/Parser.hs index a98455e9dc..cb3cece8e1 100644 --- a/ghcide/src/Development/IDE/GHC/Compat/Parser.hs +++ b/ghcide/src/Development/IDE/GHC/Compat/Parser.hs @@ -48,6 +48,8 @@ module Development.IDE.GHC.Compat.Parser ( import Development.IDE.GHC.Compat.Core import Development.IDE.GHC.Compat.Util +-- See Note [Guidelines For Using CPP In GHCIDE Import Statements] + #if !MIN_VERSION_ghc(9,0,0) import qualified ApiAnnotation as Anno import qualified HscTypes as GHC diff --git a/ghcide/src/Development/IDE/GHC/Compat/Plugins.hs b/ghcide/src/Development/IDE/GHC/Compat/Plugins.hs index 30dbdf2d6d..9f5ea50ab7 100644 --- a/ghcide/src/Development/IDE/GHC/Compat/Plugins.hs +++ b/ghcide/src/Development/IDE/GHC/Compat/Plugins.hs @@ -23,6 +23,8 @@ import Development.IDE.GHC.Compat.Core import Development.IDE.GHC.Compat.Env (hscSetFlags, hsc_dflags) import Development.IDE.GHC.Compat.Parser as Parser +-- See Note [Guidelines For Using CPP In GHCIDE Import Statements] + #if !MIN_VERSION_ghc(9,0,0) import qualified DynamicLoading as Loader import Plugins diff --git a/ghcide/src/Development/IDE/GHC/Compat/Units.hs b/ghcide/src/Development/IDE/GHC/Compat/Units.hs index dcd50db093..4c40f7f0cf 100644 --- a/ghcide/src/Development/IDE/GHC/Compat/Units.hs +++ b/ghcide/src/Development/IDE/GHC/Compat/Units.hs @@ -60,6 +60,8 @@ import Development.IDE.GHC.Compat.Env import Development.IDE.GHC.Compat.Outputable import Prelude hiding (mod) +-- See Note [Guidelines For Using CPP In GHCIDE Import Statements] + #if !MIN_VERSION_ghc(9,0,0) import qualified DynFlags import FastString diff --git a/ghcide/src/Development/IDE/GHC/Compat/Util.hs b/ghcide/src/Development/IDE/GHC/Compat/Util.hs index 6728a1e7e5..4ad42cee8a 100644 --- a/ghcide/src/Development/IDE/GHC/Compat/Util.hs +++ b/ghcide/src/Development/IDE/GHC/Compat/Util.hs @@ -69,6 +69,8 @@ module Development.IDE.GHC.Compat.Util ( atEnd, ) where +-- See Note [Guidelines For Using CPP In GHCIDE Import Statements] + #if !MIN_VERSION_ghc(9,0,0) import Bag import BooleanFormula diff --git a/ghcide/src/Development/IDE/GHC/CoreFile.hs b/ghcide/src/Development/IDE/GHC/CoreFile.hs index 35c5bd2591..1702addf52 100644 --- a/ghcide/src/Development/IDE/GHC/CoreFile.hs +++ b/ghcide/src/Development/IDE/GHC/CoreFile.hs @@ -25,6 +25,8 @@ import qualified Development.IDE.GHC.Compat.Util as Util import GHC.Fingerprint import Prelude hiding (mod) +-- See Note [Guidelines For Using CPP In GHCIDE Import Statements] + #if !MIN_VERSION_ghc(9,0,0) import Binary import BinFingerprint (fingerprintBinMem) diff --git a/ghcide/src/Development/IDE/GHC/Orphans.hs b/ghcide/src/Development/IDE/GHC/Orphans.hs index 078a5fd62a..456d7f0f07 100644 --- a/ghcide/src/Development/IDE/GHC/Orphans.hs +++ b/ghcide/src/Development/IDE/GHC/Orphans.hs @@ -18,6 +18,8 @@ import Data.Hashable import Data.String (IsString (fromString)) import Data.Text (unpack) +-- See Note [Guidelines For Using CPP In GHCIDE Import Statements] + #if !MIN_VERSION_ghc(9,0,0) import Bag import ByteCodeTypes @@ -247,7 +249,7 @@ instance NFData HomeModLinkable where rnf = rwhnf #endif -instance NFData (HsExpr (GhcPass 'Renamed)) where +instance NFData (HsExpr (GhcPass Renamed)) where rnf = rwhnf instance NFData Extension where diff --git a/ghcide/src/Development/IDE/GHC/Util.hs b/ghcide/src/Development/IDE/GHC/Util.hs index d158f139fb..c3cbf4c572 100644 --- a/ghcide/src/Development/IDE/GHC/Util.hs +++ b/ghcide/src/Development/IDE/GHC/Util.hs @@ -62,6 +62,8 @@ import GHC.IO.Handle.Types import Ide.PluginUtils (unescape) import System.FilePath +-- See Note [Guidelines For Using CPP In GHCIDE Import Statements] + #if !MIN_VERSION_ghc(9,2,0) import Development.IDE.GHC.Compat.Util #endif diff --git a/ghcide/src/Development/IDE/Import/DependencyInformation.hs b/ghcide/src/Development/IDE/Import/DependencyInformation.hs index a7460487cc..6ae27e2912 100644 --- a/ghcide/src/Development/IDE/Import/DependencyInformation.hs +++ b/ghcide/src/Development/IDE/Import/DependencyInformation.hs @@ -57,6 +57,8 @@ import Development.IDE.Types.Location import Development.IDE.GHC.Compat +-- See Note [Guidelines For Using CPP In GHCIDE Import Statements] + #if !MIN_VERSION_ghc(9,3,0) import GHC #endif diff --git a/ghcide/src/Development/IDE/Import/FindImports.hs b/ghcide/src/Development/IDE/Import/FindImports.hs index 73d33b0d2a..506487415e 100644 --- a/ghcide/src/Development/IDE/Import/FindImports.hs +++ b/ghcide/src/Development/IDE/Import/FindImports.hs @@ -27,6 +27,8 @@ import Data.List (isSuffixOf) import Data.Maybe import System.FilePath +-- See Note [Guidelines For Using CPP In GHCIDE Import Statements] + #if !MIN_VERSION_ghc(9,3,0) import Development.IDE.GHC.Compat.Util #endif diff --git a/ghcide/src/Development/IDE/LSP/HoverDefinition.hs b/ghcide/src/Development/IDE/LSP/HoverDefinition.hs index d01e631aa0..eefe1a14f4 100644 --- a/ghcide/src/Development/IDE/LSP/HoverDefinition.hs +++ b/ghcide/src/Development/IDE/LSP/HoverDefinition.hs @@ -31,16 +31,16 @@ import qualified Language.LSP.Server as LSP import qualified Data.Text as T -gotoDefinition :: IdeState -> TextDocumentPositionParams -> ExceptT PluginError (LSP.LspM c) (MessageResult 'Method_TextDocumentDefinition) +gotoDefinition :: IdeState -> TextDocumentPositionParams -> ExceptT PluginError (LSP.LspM c) (MessageResult Method_TextDocumentDefinition) hover :: IdeState -> TextDocumentPositionParams -> ExceptT PluginError (LSP.LspM c) (Hover |? Null) -gotoTypeDefinition :: IdeState -> TextDocumentPositionParams -> ExceptT PluginError (LSP.LspM c) (MessageResult 'Method_TextDocumentTypeDefinition) +gotoTypeDefinition :: IdeState -> TextDocumentPositionParams -> ExceptT PluginError (LSP.LspM c) (MessageResult Method_TextDocumentTypeDefinition) documentHighlight :: IdeState -> TextDocumentPositionParams -> ExceptT PluginError (LSP.LspM c) ([DocumentHighlight] |? Null) gotoDefinition = request "Definition" getDefinition (InR $ InR Null) (InL . Definition. InR) gotoTypeDefinition = request "TypeDefinition" getTypeDefinition (InR $ InR Null) (InL . Definition. InR) hover = request "Hover" getAtPoint (InR Null) foundHover documentHighlight = request "DocumentHighlight" highlightAtPoint (InR Null) InL -references :: PluginMethodHandler IdeState 'Method_TextDocumentReferences +references :: PluginMethodHandler IdeState Method_TextDocumentReferences references ide _ (ReferenceParams (TextDocumentIdentifier uri) pos _ _ _) = do nfp <- getNormalizedFilePathE uri liftIO $ logDebug (ideLogger ide) $ @@ -48,7 +48,7 @@ references ide _ (ReferenceParams (TextDocumentIdentifier uri) pos _ _ _) = do " in file: " <> T.pack (show nfp) InL <$> (liftIO $ runAction "references" ide $ refsAtPoint nfp pos) -wsSymbols :: PluginMethodHandler IdeState 'Method_WorkspaceSymbol +wsSymbols :: PluginMethodHandler IdeState Method_WorkspaceSymbol wsSymbols ide _ (WorkspaceSymbolParams _ _ query) = liftIO $ do logDebug (ideLogger ide) $ "Workspace symbols request: " <> query runIdeAction "WorkspaceSymbols" (shakeExtras ide) $ InL . fromMaybe [] <$> workspaceSymbols query diff --git a/ghcide/src/Development/IDE/LSP/LanguageServer.hs b/ghcide/src/Development/IDE/LSP/LanguageServer.hs index 7e6b0a9c55..51ed44f17f 100644 --- a/ghcide/src/Development/IDE/LSP/LanguageServer.hs +++ b/ghcide/src/Development/IDE/LSP/LanguageServer.hs @@ -91,7 +91,7 @@ runLanguageServer -> config -> (config -> Value -> Either T.Text config) -> (MVar () - -> IO (LSP.LanguageContextEnv config -> TRequestMessage 'Method_Initialize -> IO (Either ResponseError (LSP.LanguageContextEnv config, a)), + -> IO (LSP.LanguageContextEnv config -> TRequestMessage Method_Initialize -> IO (Either ResponseError (LSP.LanguageContextEnv config, a)), LSP.Handlers (m config), (LanguageContextEnv config, a) -> m config <~> IO)) -> IO () @@ -132,7 +132,7 @@ setupLSP :: -> LSP.Handlers (ServerM config) -> (LSP.LanguageContextEnv config -> Maybe FilePath -> WithHieDb -> IndexQueue -> IO IdeState) -> MVar () - -> IO (LSP.LanguageContextEnv config -> TRequestMessage 'Method_Initialize -> IO (Either err (LSP.LanguageContextEnv config, IdeState)), + -> IO (LSP.LanguageContextEnv config -> TRequestMessage Method_Initialize -> IO (Either err (LSP.LanguageContextEnv config, IdeState)), LSP.Handlers (ServerM config), (LanguageContextEnv config, IdeState) -> ServerM config <~> IO) setupLSP recorder getHieDbLoc userHandlers getIdeState clientMsgVar = do @@ -194,7 +194,7 @@ handleInit -> (SomeLspId -> IO ()) -> (SomeLspId -> IO ()) -> Chan ReactorMessage - -> LSP.LanguageContextEnv config -> TRequestMessage 'Method_Initialize -> IO (Either err (LSP.LanguageContextEnv config, IdeState)) + -> LSP.LanguageContextEnv config -> TRequestMessage Method_Initialize -> IO (Either err (LSP.LanguageContextEnv config, IdeState)) handleInit recorder getHieDbLoc getIdeState lifetime exitClientMsg clearReqId waitForCancel clientMsgChan env (TRequestMessage _ _ m params) = otTracedHandler "Initialize" (show m) $ \sp -> do traceWithSpan sp params let root = LSP.resRootPath env diff --git a/ghcide/src/Development/IDE/LSP/Outline.hs b/ghcide/src/Development/IDE/LSP/Outline.hs index 5b88913a64..7859e0e95e 100644 --- a/ghcide/src/Development/IDE/LSP/Outline.hs +++ b/ghcide/src/Development/IDE/LSP/Outline.hs @@ -28,6 +28,8 @@ import Language.LSP.Protocol.Types (DocumentSymbol (..), type (|?) (InL, InR), uriToFilePath) import Language.LSP.Protocol.Message +-- See Note [Guidelines For Using CPP In GHCIDE Import Statements] + #if MIN_VERSION_ghc(9,2,0) import Data.List.NonEmpty (nonEmpty) import Data.Foldable (toList) @@ -38,7 +40,7 @@ import qualified Data.Text as T #endif moduleOutline - :: PluginMethodHandler IdeState 'Method_TextDocumentDocumentSymbol + :: PluginMethodHandler IdeState Method_TextDocumentDocumentSymbol moduleOutline ideState _ DocumentSymbolParams{ _textDocument = TextDocumentIdentifier uri } = liftIO $ case uriToFilePath uri of Just (toNormalizedFilePath' -> fp) -> do diff --git a/ghcide/src/Development/IDE/LSP/Server.hs b/ghcide/src/Development/IDE/LSP/Server.hs index cebe7b3c60..28bba2d526 100644 --- a/ghcide/src/Development/IDE/LSP/Server.hs +++ b/ghcide/src/Development/IDE/LSP/Server.hs @@ -30,7 +30,7 @@ newtype ServerM c a = ServerM { unServerM :: ReaderT (ReactorChan, IdeState) (Ls deriving (Functor, Applicative, Monad, MonadReader (ReactorChan, IdeState), MonadIO, MonadUnliftIO, LSP.MonadLsp c) requestHandler - :: forall m c. PluginMethod 'Request m => + :: forall m c. PluginMethod Request m => SMethod m -> (IdeState -> MessageParams m -> LspM c (Either ResponseError (MessageResult m))) -> Handlers (ServerM c) @@ -45,7 +45,7 @@ requestHandler m k = LSP.requestHandler m $ \TRequestMessage{_method,_id,_params writeChan chan $ ReactorRequest (SomeLspId _id) (trace $ LSP.runLspT env $ resp' =<< k ide _params) (LSP.runLspT env . resp' . Left) notificationHandler - :: forall m c. PluginMethod 'Notification m => + :: forall m c. PluginMethod Notification m => SMethod m -> (IdeState -> VFS -> MessageParams m -> LspM c ()) -> Handlers (ServerM c) diff --git a/ghcide/src/Development/IDE/Plugin/Completions.hs b/ghcide/src/Development/IDE/Plugin/Completions.hs index 9fd919e9d9..e15655a3cc 100644 --- a/ghcide/src/Development/IDE/Plugin/Completions.hs +++ b/ghcide/src/Development/IDE/Plugin/Completions.hs @@ -57,6 +57,8 @@ import Development.IDE.Core.Rules (usePropertyAction) import qualified Ide.Plugin.Config as Config +-- See Note [Guidelines For Using CPP In GHCIDE Import Statements] + #if MIN_VERSION_ghc(9,2,0) import qualified GHC.LanguageExtensions as LangExt #endif @@ -127,7 +129,7 @@ dropListFromImportDecl iDecl = let f x = x in f <$> iDecl -resolveCompletion :: ResolveFunction IdeState CompletionResolveData 'Method_CompletionItemResolve +resolveCompletion :: ResolveFunction IdeState CompletionResolveData Method_CompletionItemResolve resolveCompletion ide _pid comp@CompletionItem{_detail,_documentation,_data_} uri (CompletionResolveData _ needType (NameDetails mod occ)) = do file <- getNormalizedFilePathE uri @@ -166,7 +168,7 @@ resolveCompletion ide _pid comp@CompletionItem{_detail,_documentation,_data_} ur (_,res) -> res -- | Generate code actions. -getCompletionsLSP :: PluginMethodHandler IdeState 'Method_TextDocumentCompletion +getCompletionsLSP :: PluginMethodHandler IdeState Method_TextDocumentCompletion getCompletionsLSP ide plId CompletionParams{_textDocument=TextDocumentIdentifier uri ,_position=position diff --git a/ghcide/src/Development/IDE/Plugin/Completions/Logic.hs b/ghcide/src/Development/IDE/Plugin/Completions/Logic.hs index d615611ca6..1ae75f1042 100644 --- a/ghcide/src/Development/IDE/Plugin/Completions/Logic.hs +++ b/ghcide/src/Development/IDE/Plugin/Completions/Logic.hs @@ -67,6 +67,8 @@ import Development.IDE hiding (line) import Development.IDE.Spans.AtPoint (pointCommand) +-- See Note [Guidelines For Using CPP In GHCIDE Import Statements] + #if MIN_VERSION_ghc(9,2,0) import GHC.Plugins (Depth (AllTheWay), mkUserStyle, diff --git a/ghcide/src/Development/IDE/Plugin/Completions/Types.hs b/ghcide/src/Development/IDE/Plugin/Completions/Types.hs index 0d19d74905..8902475330 100644 --- a/ghcide/src/Development/IDE/Plugin/Completions/Types.hs +++ b/ghcide/src/Development/IDE/Plugin/Completions/Types.hs @@ -25,6 +25,8 @@ import Ide.Plugin.Properties import Language.LSP.Protocol.Types (CompletionItemKind (..), Uri) import qualified Language.LSP.Protocol.Types as J +-- See Note [Guidelines For Using CPP In GHCIDE Import Statements] + #if !MIN_VERSION_ghc(9,0,0) import qualified OccName as Occ #endif @@ -58,8 +60,8 @@ extendImportCommandId :: Text extendImportCommandId = "extendImport" properties :: Properties - '[ 'PropertyKey "autoExtendOn" 'TBoolean, - 'PropertyKey "snippetsOn" 'TBoolean] + '[ 'PropertyKey "autoExtendOn" TBoolean, + 'PropertyKey "snippetsOn" TBoolean] properties = emptyProperties & defineBooleanProperty #snippetsOn "Inserts snippets when using code completions" diff --git a/ghcide/src/Development/IDE/Plugin/HLS.hs b/ghcide/src/Development/IDE/Plugin/HLS.hs index 323a01e57d..b70d19e0f2 100644 --- a/ghcide/src/Development/IDE/Plugin/HLS.hs +++ b/ghcide/src/Development/IDE/Plugin/HLS.hs @@ -329,11 +329,11 @@ logErrors recorder errs = do -- | Combine the 'PluginHandler' for all plugins -newtype IdeHandler (m :: Method 'ClientToServer 'Request) +newtype IdeHandler (m :: Method ClientToServer Request) = IdeHandler [(PluginId, PluginDescriptor IdeState, IdeState -> MessageParams m -> LSP.LspM Config (NonEmpty (Either PluginError (MessageResult m))))] -- | Combine the 'PluginHandler' for all plugins -newtype IdeNotificationHandler (m :: Method 'ClientToServer 'Notification) +newtype IdeNotificationHandler (m :: Method ClientToServer Notification) = IdeNotificationHandler [(PluginId, PluginDescriptor IdeState, IdeState -> VFS -> MessageParams m -> LSP.LspM Config ())] -- type NotificationHandler (m :: Method ClientToServer Notification) = MessageParams m -> IO ()` diff --git a/ghcide/src/Development/IDE/Plugin/HLS/GhcIde.hs b/ghcide/src/Development/IDE/Plugin/HLS/GhcIde.hs index b29e965afb..f85f0c8522 100644 --- a/ghcide/src/Development/IDE/Plugin/HLS/GhcIde.hs +++ b/ghcide/src/Development/IDE/Plugin/HLS/GhcIde.hs @@ -59,7 +59,7 @@ descriptor plId = (defaultPluginDescriptor plId) -- --------------------------------------------------------------------- -hover' :: PluginMethodHandler IdeState 'Method_TextDocumentHover +hover' :: PluginMethodHandler IdeState Method_TextDocumentHover hover' ideState _ HoverParams{..} = do liftIO $ logDebug (ideLogger ideState) "GhcIde.hover entered (ideLogger)" -- AZ hover ideState TextDocumentPositionParams{..} diff --git a/ghcide/src/Development/IDE/Plugin/TypeLenses.hs b/ghcide/src/Development/IDE/Plugin/TypeLenses.hs index 9649daa50a..338cd118d3 100644 --- a/ghcide/src/Development/IDE/Plugin/TypeLenses.hs +++ b/ghcide/src/Development/IDE/Plugin/TypeLenses.hs @@ -102,7 +102,7 @@ descriptor recorder plId = , pluginConfigDescriptor = defaultConfigDescriptor {configCustomConfig = mkCustomConfig properties} } -properties :: Properties '[ 'PropertyKey "mode" ('TEnum Mode)] +properties :: Properties '[ 'PropertyKey "mode" (TEnum Mode)] properties = emptyProperties & defineEnumProperty #mode "Control how type lenses are shown" [ (Always, "Always displays type lenses of global bindings") @@ -110,7 +110,7 @@ properties = emptyProperties , (Diagnostics, "Follows error messages produced by GHC about missing signatures") ] Always -codeLensProvider :: PluginMethodHandler IdeState 'Method_TextDocumentCodeLens +codeLensProvider :: PluginMethodHandler IdeState Method_TextDocumentCodeLens codeLensProvider ideState pId CodeLensParams{_textDocument = TextDocumentIdentifier uri} = do mode <- liftIO $ runAction "codeLens.config" ideState $ usePropertyAction #mode pId properties nfp <- getNormalizedFilePathE uri @@ -162,7 +162,7 @@ codeLensProvider ideState pId CodeLensParams{_textDocument = TextDocumentIdentif let allDiags = diags <> hDiags pure $ InL $ generateLensFromGlobalDiags allDiags -codeLensResolveProvider :: ResolveFunction IdeState TypeLensesResolve 'Method_CodeLensResolve +codeLensResolveProvider :: ResolveFunction IdeState TypeLensesResolve Method_CodeLensResolve codeLensResolveProvider ideState pId lens@CodeLens{_range} uri TypeLensesResolve = do nfp <- getNormalizedFilePathE uri (gblSigs@(GlobalBindingTypeSigsResult _), pm) <- diff --git a/ghcide/src/Development/IDE/Types/Location.hs b/ghcide/src/Development/IDE/Types/Location.hs index 6b822a02bf..6939f2b27d 100644 --- a/ghcide/src/Development/IDE/Types/Location.hs +++ b/ghcide/src/Development/IDE/Types/Location.hs @@ -36,6 +36,8 @@ import Language.LSP.Protocol.Types (Location (..), Position (..), import qualified Language.LSP.Protocol.Types as LSP import Text.ParserCombinators.ReadP as ReadP +-- See Note [Guidelines For Using CPP In GHCIDE Import Statements] + #if !MIN_VERSION_ghc(9,0,0) import FastString import SrcLoc as GHC