diff --git a/ghcide/src/Development/IDE/Core/Preprocessor.hs b/ghcide/src/Development/IDE/Core/Preprocessor.hs index 08a41b0ed4..d41a7f9795 100644 --- a/ghcide/src/Development/IDE/Core/Preprocessor.hs +++ b/ghcide/src/Development/IDE/Core/Preprocessor.hs @@ -1,6 +1,6 @@ -- Copyright (c) 2019 The DAML Authors. All rights reserved. -- SPDX-License-Identifier: Apache-2.0 -{-# LANGUAGE CPP #-} +{-# LANGUAGE CPP #-} module Development.IDE.Core.Preprocessor ( preprocessor @@ -30,8 +30,8 @@ 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) +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/Shake.hs b/ghcide/src/Development/IDE/Core/Shake.hs index 9728fd0410..6d43d6e43f 100644 --- a/ghcide/src/Development/IDE/Core/Shake.hs +++ b/ghcide/src/Development/IDE/Core/Shake.hs @@ -130,11 +130,10 @@ import Development.IDE.GHC.Compat (NameCache, NameCacheUpdater (..), initNameCache, knownKeyNames, + mkSplitUniqSupply) #if !MIN_VERSION_ghc(9,3,0) - upNameCache, +import Development.IDE.GHC.Compat (upNameCache) #endif - mkSplitUniqSupply - ) import Development.IDE.GHC.Orphans () import Development.IDE.Graph hiding (ShakeValue) import qualified Development.IDE.Graph as Shake diff --git a/ghcide/src/Development/IDE/GHC/CPP.hs b/ghcide/src/Development/IDE/GHC/CPP.hs index fc18450292..d0aaec5e95 100644 --- a/ghcide/src/Development/IDE/GHC/CPP.hs +++ b/ghcide/src/Development/IDE/GHC/CPP.hs @@ -35,7 +35,7 @@ import DynFlags #endif #endif #if MIN_VERSION_ghc(9,3,0) -import qualified GHC.Driver.Pipeline.Execute as Pipeline +import qualified GHC.Driver.Pipeline.Execute as Pipeline #endif addOptP :: String -> DynFlags -> DynFlags diff --git a/ghcide/src/Development/IDE/GHC/Compat/Env.hs b/ghcide/src/Development/IDE/GHC/Compat/Env.hs index 0909e78366..596593376d 100644 --- a/ghcide/src/Development/IDE/GHC/Compat/Env.hs +++ b/ghcide/src/Development/IDE/GHC/Compat/Env.hs @@ -91,11 +91,6 @@ import HscTypes as Env import Module #endif -#if MIN_VERSION_ghc(9,3,0) -hsc_EPS :: HscEnv -> UnitEnv -hsc_EPS = hsc_unit_env -#endif - #if MIN_VERSION_ghc(9,0,0) #if !MIN_VERSION_ghc(9,2,0) import qualified Data.Set as Set @@ -105,6 +100,11 @@ import qualified Data.Set as Set import Data.IORef #endif +#if MIN_VERSION_ghc(9,3,0) +hsc_EPS :: HscEnv -> UnitEnv +hsc_EPS = hsc_unit_env +#endif + #if !MIN_VERSION_ghc(9,2,0) type UnitEnv = () newtype Logger = Logger { log_action :: LogAction } diff --git a/ghcide/src/Development/IDE/GHC/Compat/Logger.hs b/ghcide/src/Development/IDE/GHC/Compat/Logger.hs index 6e8c6dca52..cffac134ab 100644 --- a/ghcide/src/Development/IDE/GHC/Compat/Logger.hs +++ b/ghcide/src/Development/IDE/GHC/Compat/Logger.hs @@ -25,7 +25,7 @@ import DynFlags import Outputable (queryQual) #endif #if MIN_VERSION_ghc(9,3,0) -import GHC.Types.Error +import GHC.Types.Error #endif putLogHook :: Logger -> HscEnv -> HscEnv diff --git a/ghcide/src/Development/IDE/GHC/Compat/Plugins.hs b/ghcide/src/Development/IDE/GHC/Compat/Plugins.hs index 12cf035483..b241c150c6 100644 --- a/ghcide/src/Development/IDE/GHC/Compat/Plugins.hs +++ b/ghcide/src/Development/IDE/GHC/Compat/Plugins.hs @@ -24,12 +24,12 @@ import qualified GHC.Driver.Env as Env import GHC.Driver.Plugins (Plugin (..), PluginWithArgs (..), StaticPlugin (..), + defaultPlugin, withPlugins) #if MIN_VERSION_ghc(9,3,0) - staticPlugins, - ParsedResult(..), - PsMessages(..), +import GHC.Driver.Plugins (ParsedResult (..), + PsMessages (..), + staticPlugins) #endif - defaultPlugin, withPlugins) import qualified GHC.Runtime.Loader as Loader #elif MIN_VERSION_ghc(8,8,0) import qualified DynamicLoading as Loader @@ -48,11 +48,10 @@ applyPluginsParsedResultAction env dflags ms hpm_annotations parsed = do -- Apply parsedResultAction of plugins let applyPluginAction p opts = parsedResultAction p opts ms #if MIN_VERSION_ghc(9,3,0) - fmap (hpm_module . parsedResultModule) $ + fmap (hpm_module . parsedResultModule) $ runHsc env $ withPlugins #else - fmap hpm_module $ + fmap hpm_module $ runHsc env $ withPlugins #endif - runHsc env $ withPlugins #if MIN_VERSION_ghc(9,3,0) (Env.hsc_plugins env) #elif MIN_VERSION_ghc(9,2,0) diff --git a/ghcide/src/Development/IDE/GHC/Compat/Units.hs b/ghcide/src/Development/IDE/GHC/Compat/Units.hs index c4a56bec5f..a96c8be564 100644 --- a/ghcide/src/Development/IDE/GHC/Compat/Units.hs +++ b/ghcide/src/Development/IDE/GHC/Compat/Units.hs @@ -52,11 +52,11 @@ module Development.IDE.GHC.Compat.Units ( showSDocForUser', ) where -import qualified Data.List.NonEmpty as NE -import qualified Data.Map.Strict as Map -import Control.Monad +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 +import GHC.Unit.Home.ModInfo #endif #if MIN_VERSION_ghc(9,0,0) #if MIN_VERSION_ghc(9,2,0) diff --git a/ghcide/src/Development/IDE/GHC/Orphans.hs b/ghcide/src/Development/IDE/GHC/Orphans.hs index d4f5c51972..6a2ddc7586 100644 --- a/ghcide/src/Development/IDE/GHC/Orphans.hs +++ b/ghcide/src/Development/IDE/GHC/Orphans.hs @@ -44,7 +44,7 @@ import GHC.ByteCode.Types import ByteCodeTypes #endif #if MIN_VERSION_ghc(9,3,0) -import GHC.Types.PkgQual +import GHC.Types.PkgQual #endif -- Orphan instances for types from the GHC API. @@ -217,8 +217,8 @@ instance NFData HomeModInfo where #if MIN_VERSION_ghc(9,3,0) instance NFData PkgQual where - rnf NoPkgQual = () - rnf (ThisPkg uid) = rnf uid + rnf NoPkgQual = () + rnf (ThisPkg uid) = rnf uid rnf (OtherPkg uid) = rnf uid instance NFData UnitId where diff --git a/ghcide/src/Development/IDE/GHC/Warnings.hs b/ghcide/src/Development/IDE/GHC/Warnings.hs index fa30373ce8..9ddda656c9 100644 --- a/ghcide/src/Development/IDE/GHC/Warnings.hs +++ b/ghcide/src/Development/IDE/GHC/Warnings.hs @@ -1,7 +1,7 @@ -- Copyright (c) 2019 The DAML Authors. All rights reserved. -- SPDX-License-Identifier: Apache-2.0 +{-# LANGUAGE CPP #-} {-# LANGUAGE ExplicitNamespaces #-} -{-# LANGUAGE CPP #-} module Development.IDE.GHC.Warnings(withWarnings) where @@ -49,8 +49,8 @@ attachReason Nothing d = d attachReason (Just wr) d = d{_code = InR <$> showReason wr} where showReason = \case - WarningWithFlag flag -> showFlag flag - _ -> Nothing + WarningWithFlag flag -> showFlag flag + _ -> Nothing #else attachReason :: WarnReason -> Diagnostic -> Diagnostic attachReason wr d = d{_code = InR <$> showReason wr} diff --git a/ghcide/src/Development/IDE/Plugin/Completions.hs b/ghcide/src/Development/IDE/Plugin/Completions.hs index 8e95614a27..4a02d94bf9 100644 --- a/ghcide/src/Development/IDE/Plugin/Completions.hs +++ b/ghcide/src/Development/IDE/Plugin/Completions.hs @@ -8,46 +8,45 @@ module Development.IDE.Plugin.Completions , ghcideCompletionsPluginPriority ) where -import Control.Concurrent.Async (concurrently) -import Control.Concurrent.STM.Stats (readTVarIO) +import Control.Concurrent.Async (concurrently) +import Control.Concurrent.STM.Stats (readTVarIO) import Control.Monad.Extra import Control.Monad.IO.Class import Control.Monad.Trans.Maybe import Data.Aeson -import qualified Data.HashMap.Strict as Map -import qualified Data.HashSet as Set -import Data.List (find) +import qualified Data.HashMap.Strict as Map +import qualified Data.HashSet as Set +import Data.List (find) import Data.Maybe -import qualified Data.Text as T +import qualified Data.Text as T 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 qualified Development.IDE.Core.Shake as Shake +import Development.IDE.Core.Service hiding (Log, LogShake) +import Development.IDE.Core.Shake hiding (Log) +import qualified Development.IDE.Core.Shake as Shake import Development.IDE.GHC.Compat -import Development.IDE.GHC.Error (rangeToSrcSpan) -import Development.IDE.GHC.Util (printOutputable) +import Development.IDE.GHC.Error (rangeToSrcSpan) +import Development.IDE.GHC.Util (printOutputable) import Development.IDE.Graph import Development.IDE.Plugin.Completions.Logic import Development.IDE.Plugin.Completions.Types import Development.IDE.Types.Exports -import Development.IDE.Types.HscEnvEq (HscEnvEq (envPackageExports), - hscEnv) -import qualified Development.IDE.Types.KnownTargets as KT +import Development.IDE.Types.HscEnvEq (HscEnvEq (envPackageExports), + hscEnv) +import qualified Development.IDE.Types.KnownTargets as KT import Development.IDE.Types.Location -import Development.IDE.Types.Logger (Pretty (pretty), - Recorder, - WithPriority, - cmapWithPrio) -import GHC.Exts (fromList, toList) -import Ide.Plugin.Config (Config) +import Development.IDE.Types.Logger (Pretty (pretty), + Recorder, + WithPriority, + cmapWithPrio) +import GHC.Exts (fromList, toList) +import Ide.Plugin.Config (Config) import Ide.Types -import qualified Language.LSP.Server as LSP +import qualified Language.LSP.Server as LSP import Language.LSP.Types -import qualified Language.LSP.VFS as VFS +import qualified Language.LSP.VFS as VFS import Numeric.Natural -import Text.Fuzzy.Parallel (Scored (..)) +import Text.Fuzzy.Parallel (Scored (..)) data Log = LogShake Shake.Log deriving Show diff --git a/ghcide/src/Development/IDE/Spans/Common.hs b/ghcide/src/Development/IDE/Spans/Common.hs index 701074b3ac..00b98ded2a 100644 --- a/ghcide/src/Development/IDE/Spans/Common.hs +++ b/ghcide/src/Development/IDE/Spans/Common.hs @@ -49,10 +49,11 @@ safeTyThingId (AConLike (RealDataCon dataCon)) = Just (dataConWrapId dataCon) safeTyThingId _ = Nothing -- Possible documentation for an element in the code -data SpanDoc #if MIN_VERSION_ghc(9,3,0) +data SpanDoc = SpanDocString [HsDocString] SpanDocUris #else +data SpanDoc = SpanDocString HsDocString SpanDocUris #endif | SpanDocText [T.Text] SpanDocUris diff --git a/ghcide/src/Development/IDE/Spans/Documentation.hs b/ghcide/src/Development/IDE/Spans/Documentation.hs index 08ad918bc4..63f84966a3 100644 --- a/ghcide/src/Development/IDE/Spans/Documentation.hs +++ b/ghcide/src/Development/IDE/Spans/Documentation.hs @@ -34,7 +34,7 @@ import System.FilePath import Language.LSP.Types (filePathToUri, getUri) #if MIN_VERSION_ghc(9,3,0) -import GHC.Types.Unique.Map +import GHC.Types.Unique.Map #endif mkDocMap diff --git a/hls-plugin-api/src/Ide/Types.hs b/hls-plugin-api/src/Ide/Types.hs index e9fbe8a28d..997300900a 100644 --- a/hls-plugin-api/src/Ide/Types.hs +++ b/hls-plugin-api/src/Ide/Types.hs @@ -56,6 +56,7 @@ import Control.Monad (void) import qualified System.Posix.Process as P (getProcessID) import System.Posix.Signals #endif +import Control.Applicative ((<|>)) import Control.Arrow ((&&&)) import Control.Lens ((^.)) import Data.Aeson hiding (defaultOptions) @@ -67,7 +68,7 @@ import Data.GADT.Compare import Data.Hashable (Hashable) import Data.HashMap.Strict (HashMap) import qualified Data.HashMap.Strict as HashMap -import Data.List.Extra (sortOn, find) +import Data.List.Extra (find, sortOn) import Data.List.NonEmpty (NonEmpty (..), toList) import qualified Data.Map as Map import Data.Maybe @@ -107,12 +108,11 @@ import Options.Applicative (ParserInfo) import System.FilePath import System.IO.Unsafe import Text.Regex.TDFA.Text () -import Control.Applicative ((<|>)) -- --------------------------------------------------------------------- data IdePlugins ideState = IdePlugins_ - { ipMap_ :: HashMap PluginId (PluginDescriptor ideState) + { ipMap_ :: HashMap PluginId (PluginDescriptor ideState) , lookupCommandProvider :: CommandId -> Maybe PluginId } diff --git a/plugins/hls-code-range-plugin/src/Ide/Plugin/CodeRange/Rules.hs b/plugins/hls-code-range-plugin/src/Ide/Plugin/CodeRange/Rules.hs index 992bf6ca28..05515bb8e8 100644 --- a/plugins/hls-code-range-plugin/src/Ide/Plugin/CodeRange/Rules.hs +++ b/plugins/hls-code-range-plugin/src/Ide/Plugin/CodeRange/Rules.hs @@ -45,8 +45,7 @@ import Development.IDE import Development.IDE.Core.Rules (toIdeResult) import qualified Development.IDE.Core.Shake as Shake import Development.IDE.GHC.Compat (HieAST (..), - HieASTs (getAsts), - RefMap) + HieASTs (getAsts), RefMap) import Development.IDE.GHC.Compat.Util import GHC.Generics (Generic) import Ide.Plugin.CodeRange.ASTPreProcess (CustomNodeType (..), diff --git a/plugins/hls-refactor-plugin/src/Development/IDE/GHC/Dump.hs b/plugins/hls-refactor-plugin/src/Development/IDE/GHC/Dump.hs index cde3f79c48..19e7efe6e6 100644 --- a/plugins/hls-refactor-plugin/src/Development/IDE/GHC/Dump.hs +++ b/plugins/hls-refactor-plugin/src/Development/IDE/GHC/Dump.hs @@ -1,7 +1,7 @@ {-# LANGUAGE CPP #-} module Development.IDE.GHC.Dump(showAstDataHtml) where -import Data.Data hiding (Fixity) -import Development.IDE.GHC.Compat hiding (NameAnn) +import Data.Data hiding (Fixity) +import Development.IDE.GHC.Compat hiding (NameAnn) import Development.IDE.GHC.Compat.ExactPrint #if MIN_VERSION_ghc(8,10,1) import GHC.Hs.Dump @@ -9,9 +9,9 @@ import GHC.Hs.Dump import HsDumpAst #endif #if MIN_VERSION_ghc(9,2,1) -import qualified Data.ByteString as B +import qualified Data.ByteString as B import Development.IDE.GHC.Compat.Util -import Generics.SYB (ext1Q, ext2Q, extQ) +import Generics.SYB (ext1Q, ext2Q, extQ) import GHC.Hs #endif #if MIN_VERSION_ghc(9,0,1) @@ -19,7 +19,7 @@ import GHC.Plugins #else import GhcPlugins #endif -import Prelude hiding ((<>)) +import Prelude hiding ((<>)) -- | Show a GHC syntax tree in HTML. #if MIN_VERSION_ghc(9,2,1) diff --git a/plugins/hls-refactor-plugin/src/Development/IDE/Plugin/CodeAction/Util.hs b/plugins/hls-refactor-plugin/src/Development/IDE/Plugin/CodeAction/Util.hs index bfcb0d7a37..6f51131bd6 100644 --- a/plugins/hls-refactor-plugin/src/Development/IDE/Plugin/CodeAction/Util.hs +++ b/plugins/hls-refactor-plugin/src/Development/IDE/Plugin/CodeAction/Util.hs @@ -1,12 +1,5 @@ module Development.IDE.Plugin.CodeAction.Util where -#if MIN_VERSION_ghc(9,2,0) -import GHC.Utils.Outputable -#else -import Development.IDE.GHC.Util -import Development.IDE.GHC.Compat.Util -import Development.IDE.GHC.Compat -#endif import Data.Data (Data) import qualified Data.Unique as U import Debug.Trace @@ -18,6 +11,13 @@ import Text.Printf import Development.IDE.GHC.Dump (showAstDataHtml) import Data.Time.Clock.POSIX (POSIXTime, getCurrentTime, utcTimeToPOSIXSeconds) +#if MIN_VERSION_ghc(9,2,0) +import GHC.Utils.Outputable +#else +import Development.IDE.GHC.Util +import Development.IDE.GHC.Compat.Util +import Development.IDE.GHC.Compat +#endif -------------------------------------------------------------------------------- -- Tracing exactprint terms diff --git a/plugins/hls-rename-plugin/src/Ide/Plugin/Rename.hs b/plugins/hls-rename-plugin/src/Ide/Plugin/Rename.hs index c6c1238b61..8a22172a67 100644 --- a/plugins/hls-rename-plugin/src/Ide/Plugin/Rename.hs +++ b/plugins/hls-rename-plugin/src/Ide/Plugin/Rename.hs @@ -29,7 +29,7 @@ import qualified Data.Map as M import Data.Maybe import Data.Mod.Word import qualified Data.Text as T -import Development.IDE (Recorder, WithPriority) +import Development.IDE (Recorder, WithPriority) import Development.IDE.Core.PositionMapping import Development.IDE.Core.RuleTypes import Development.IDE.Core.Service @@ -40,10 +40,10 @@ import Development.IDE.GHC.Compat.Parser import Development.IDE.GHC.Compat.Units import Development.IDE.GHC.Error import Development.IDE.GHC.ExactPrint -import qualified Development.IDE.GHC.ExactPrint as E +import qualified Development.IDE.GHC.ExactPrint as E +import Development.IDE.Plugin.CodeAction import Development.IDE.Spans.AtPoint import Development.IDE.Types.Location -import Development.IDE.Plugin.CodeAction import HieDb.Query import Ide.Plugin.Properties import Ide.PluginUtils diff --git a/test/functional/Format.hs b/test/functional/Format.hs index b3829c3a9f..e08809a8ec 100644 --- a/test/functional/Format.hs +++ b/test/functional/Format.hs @@ -6,9 +6,9 @@ import Control.Lens ((^.)) import Control.Monad.IO.Class import Data.Aeson import qualified Data.ByteString.Lazy as BS +import qualified Data.Text as T import qualified Data.Text.Encoding as T import qualified Data.Text.IO as T -import qualified Data.Text as T import Language.LSP.Test import Language.LSP.Types import qualified Language.LSP.Types.Lens as LSP