diff --git a/ghcide-bench/src/Experiments.hs b/ghcide-bench/src/Experiments.hs index dc2eeced35..587f27781b 100644 --- a/ghcide-bench/src/Experiments.hs +++ b/ghcide-bench/src/Experiments.hs @@ -31,7 +31,6 @@ import Control.Lens.Extras (is) import Control.Monad.Extra (allM, forM, forM_, forever, unless, void, when, whenJust, (&&^)) -import Control.Monad.Fail (MonadFail) import Control.Monad.IO.Class import Data.Aeson (Value (Null), eitherDecodeStrict', diff --git a/hls-graph/src/Development/IDE/Graph/Internal/Profile.hs b/hls-graph/src/Development/IDE/Graph/Internal/Profile.hs index 0403e43a5a..39397dc19e 100644 --- a/hls-graph/src/Development/IDE/Graph/Internal/Profile.hs +++ b/hls-graph/src/Development/IDE/Graph/Internal/Profile.hs @@ -21,7 +21,6 @@ import Data.List.Extra (nubOrd) import Data.Maybe import Data.Time (getCurrentTime) import Data.Time.Format.ISO8601 (iso8601Show) -import Development.IDE.Graph.Classes import Development.IDE.Graph.Internal.Database (getDirtySet) import Development.IDE.Graph.Internal.Paths import Development.IDE.Graph.Internal.Types diff --git a/hls-graph/src/Development/IDE/Graph/Internal/Types.hs b/hls-graph/src/Development/IDE/Graph/Internal/Types.hs index 640a4cc609..1c7d83695b 100644 --- a/hls-graph/src/Development/IDE/Graph/Internal/Types.hs +++ b/hls-graph/src/Development/IDE/Graph/Internal/Types.hs @@ -7,7 +7,6 @@ module Development.IDE.Graph.Internal.Types where -import Control.Applicative import Control.Monad.Catch import Control.Monad.IO.Class import Control.Monad.Trans.Reader @@ -37,6 +36,9 @@ import System.IO.Unsafe import System.Time.Extra (Seconds) import UnliftIO (MonadUnliftIO) +#if !MIN_VERSION_base(4,18,0) +import Control.Applicative (liftA2) +#endif unwrapDynamic :: forall a . Typeable a => Dynamic -> a unwrapDynamic x = fromMaybe (error msg) $ fromDynamic x diff --git a/plugins/hls-module-name-plugin/src/Ide/Plugin/ModuleName.hs b/plugins/hls-module-name-plugin/src/Ide/Plugin/ModuleName.hs index 83f73ab4ff..b2f1e130ec 100644 --- a/plugins/hls-module-name-plugin/src/Ide/Plugin/ModuleName.hs +++ b/plugins/hls-module-name-plugin/src/Ide/Plugin/ModuleName.hs @@ -4,8 +4,7 @@ {-# LANGUAGE RecordWildCards #-} {-# LANGUAGE ViewPatterns #-} -{-# OPTIONS_GHC -Wall -Wwarn -fno-warn-type-defaults #-} -{-# OPTIONS_GHC -Wno-name-shadowing #-} +{-# OPTIONS_GHC -Wwarn -fno-warn-type-defaults #-} {- | Keep the module name in sync with its file path. diff --git a/plugins/hls-qualify-imported-names-plugin/src/Ide/Plugin/QualifyImportedNames.hs b/plugins/hls-qualify-imported-names-plugin/src/Ide/Plugin/QualifyImportedNames.hs index 838afde180..1e48e204cf 100644 --- a/plugins/hls-qualify-imported-names-plugin/src/Ide/Plugin/QualifyImportedNames.hs +++ b/plugins/hls-qualify-imported-names-plugin/src/Ide/Plugin/QualifyImportedNames.hs @@ -8,13 +8,11 @@ module Ide.Plugin.QualifyImportedNames (descriptor) where import Control.Lens ((^.)) import Control.Monad (foldM) -import Control.Monad.IO.Class (MonadIO (liftIO)) import Control.Monad.Trans.State.Strict (State) import qualified Control.Monad.Trans.State.Strict as State import Data.DList (DList) import qualified Data.DList as DList import Data.Foldable (Foldable (foldl'), find) -import qualified Data.HashMap.Strict as HashMap import Data.List (sortOn) import qualified Data.List as List import qualified Data.Map.Strict as Map @@ -28,8 +26,7 @@ import Development.IDE.Core.RuleTypes (GetFileContents (GetFileConte HieAstResult (HAR, refMap), TcModuleResult (TcModuleResult, tmrParsed, tmrTypechecked), TypeCheck (TypeCheck)) -import Development.IDE.Core.Service (runAction) -import Development.IDE.Core.Shake (IdeState, use) +import Development.IDE.Core.Shake (IdeState) import Development.IDE.GHC.Compat (ContextInfo (Use), GenLocated (..), GhcPs, GlobalRdrElt, GlobalRdrEnv, @@ -55,14 +52,11 @@ import Development.IDE.GHC.Compat (ContextInfo (Use), srcSpanEndLine, srcSpanStartCol, srcSpanStartLine, unitUFM) -import Development.IDE.GHC.Error (isInsideSrcSpan) -import Development.IDE.Types.Location (NormalizedFilePath, - Position (Position), - Range (Range), Uri, - toNormalizedUri) +import Development.IDE.Types.Location (Position (Position), + Range (Range), Uri) import Ide.Plugin.Error (PluginError (PluginRuleFailed), getNormalizedFilePathE, - handleMaybe, handleMaybeM) + handleMaybe) import Ide.Types (PluginDescriptor (pluginHandlers), PluginId, PluginMethodHandler, @@ -74,11 +68,9 @@ import Language.LSP.Protocol.Message (Method (Method_TextDocumentCo import Language.LSP.Protocol.Types (CodeAction (CodeAction, _command, _data_, _diagnostics, _disabled, _edit, _isPreferred, _kind, _title), CodeActionKind (CodeActionKind_QuickFix), CodeActionParams (CodeActionParams), - TextDocumentIdentifier (TextDocumentIdentifier), TextEdit (TextEdit), WorkspaceEdit (WorkspaceEdit, _changeAnnotations, _changes, _documentChanges), - type (|?) (InL, InR), - uriToNormalizedFilePath) + type (|?) (InL, InR)) thenCmp :: Ordering -> Ordering -> Ordering {-# INLINE thenCmp #-} diff --git a/plugins/hls-qualify-imported-names-plugin/test/Main.hs b/plugins/hls-qualify-imported-names-plugin/test/Main.hs index afd8f29d47..824ce32065 100644 --- a/plugins/hls-qualify-imported-names-plugin/test/Main.hs +++ b/plugins/hls-qualify-imported-names-plugin/test/Main.hs @@ -1,5 +1,4 @@ {-# LANGUAGE BlockArguments #-} -{-# LANGUAGE MultiWayIf #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE RecordWildCards #-} @@ -10,9 +9,7 @@ import Data.Text (Text) import qualified Ide.Plugin.QualifyImportedNames as QualifyImportedNames import System.FilePath (()) import Test.Hls (CodeAction (CodeAction, _title), - Command (Command), IdeState, - MonadIO (liftIO), - PluginDescriptor, + Command, MonadIO (liftIO), PluginTestDescriptor, Position (Position), Range (Range), Session, @@ -24,10 +21,9 @@ import Test.Hls (CodeAction (CodeAction, _title getCodeActions, goldenWithHaskellDoc, mkPluginTestDescriptor', - openDoc, rename, - runSessionWithServer, + openDoc, runSessionWithServer, testCase, testGroup, - type (|?) (InR), (@?=)) + type (|?) (InR)) import Prelude @@ -37,6 +33,7 @@ data Point = Point { column :: !Int } +makePoint :: Int -> Int -> Point makePoint line column | line >= 1 && column >= 1 = Point line column | otherwise = error "Line or column is less than 1." diff --git a/plugins/hls-refactor-plugin/src/Development/IDE/GHC/ExactPrint.hs b/plugins/hls-refactor-plugin/src/Development/IDE/GHC/ExactPrint.hs index 8e570d9dc0..f8ca0aa13f 100644 --- a/plugins/hls-refactor-plugin/src/Development/IDE/GHC/ExactPrint.hs +++ b/plugins/hls-refactor-plugin/src/Development/IDE/GHC/ExactPrint.hs @@ -1,5 +1,5 @@ -{-# LANGUAGE TypeFamilies #-} {-# LANGUAGE GADTs #-} +{-# LANGUAGE TypeFamilies #-} -- | This module hosts various abstractions and utility functions to work with ghc-exactprint. module Development.IDE.GHC.ExactPrint @@ -43,7 +43,7 @@ module Development.IDE.GHC.ExactPrint where import Control.Applicative (Alternative) -import Control.Arrow (right, (***)) +import Control.Arrow ((***)) import Control.DeepSeq import Control.Monad import qualified Control.Monad.Fail as Fail @@ -56,14 +56,11 @@ import Data.Bool (bool) import Data.Default (Default) import qualified Data.DList as DL import Data.Either.Extra (mapLeft) -import Data.Foldable (Foldable (fold)) import Data.Functor.Classes import Data.Functor.Contravariant import Data.Monoid (All (All), getAll) import qualified Data.Text as T -import Data.Traversable (for) import Development.IDE.Core.RuleTypes -import Development.IDE.Core.Service (runAction) import Development.IDE.Core.Shake hiding (Log) import qualified Development.IDE.Core.Shake as Shake import Development.IDE.GHC.Compat hiding (parseImport, @@ -72,14 +69,13 @@ import Development.IDE.GHC.Compat hiding (parseImport, import Development.IDE.GHC.Compat.ExactPrint import Development.IDE.Graph (RuleResult, Rules) import Development.IDE.Graph.Classes -import Development.IDE.Types.Location -import Ide.Logger (Pretty (pretty), - Recorder, - WithPriority, - cmapWithPrio) import Generics.SYB import Generics.SYB.GHC import qualified GHC.Generics as GHC +import Ide.Logger (Pretty (pretty), + Recorder, + WithPriority, + cmapWithPrio) import Ide.PluginUtils import Language.Haskell.GHC.ExactPrint.Parsers import Language.LSP.Protocol.Types @@ -100,16 +96,19 @@ import GHC (EpAnn (..), emptyComments, spanAsAnchor) import GHC.Parser.Annotation (AnnContext (..), - DeltaPos (SameLine), EpaLocation (EpaDelta), deltaPos) #endif -import Data.List (partition) -import GHC (Anchor(..), realSrcSpan, AnchorOperation, DeltaPos(..), SrcSpanAnnN) -import GHC.Types.SrcLoc (generatedSrcSpan) -import Control.Lens ((&), _last) -import Control.Lens.Operators ((%~)) +import Control.Lens (_last, (&)) +import Control.Lens.Operators ((%~)) +import Data.List (partition) +import GHC (Anchor (..), + AnchorOperation, + DeltaPos (..), + SrcSpanAnnN, + realSrcSpan) +import GHC.Types.SrcLoc (generatedSrcSpan) setPrecedingLines :: Default t => LocatedAn t a -> Int -> Int -> LocatedAn t a setPrecedingLines ast n c = setEntryDP ast (deltaPos n c) diff --git a/plugins/hls-refactor-plugin/src/Development/IDE/Plugin/CodeAction.hs b/plugins/hls-refactor-plugin/src/Development/IDE/Plugin/CodeAction.hs index 48c33ea07b..cf61feebe6 100644 --- a/plugins/hls-refactor-plugin/src/Development/IDE/Plugin/CodeAction.hs +++ b/plugins/hls-refactor-plugin/src/Development/IDE/Plugin/CodeAction.hs @@ -68,14 +68,6 @@ import Development.IDE.Plugin.TypeLenses (suggestSigna import Development.IDE.Types.Exports import Development.IDE.Types.Location import Development.IDE.Types.Options -import GHC.Exts (fromList) -import qualified GHC.LanguageExtensions as Lang -import Ide.Logger hiding - (group) -import qualified Text.Regex.Applicative as RE -#if MIN_VERSION_ghc(9,4,0) -import GHC.Parser.Annotation (TokenLocation (..)) -#endif import GHC (AddEpAnn (AddEpAnn), Anchor (anchor_op), AnchorOperation (..), @@ -83,8 +75,11 @@ import GHC (AddEpAnn (Ad DeltaPos (..), EpAnn (..), EpaLocation (..), - LEpaComment, - hsmodAnn) + LEpaComment) +import GHC.Exts (fromList) +import qualified GHC.LanguageExtensions as Lang +import Ide.Logger hiding + (group) import Ide.PluginUtils (extractTextInRange, subRange) import Ide.Types @@ -110,6 +105,7 @@ import qualified Language.LSP.Server as LSP import Language.LSP.VFS (VirtualFile, _file_text) import qualified Text.Fuzzy.Parallel as TFP +import qualified Text.Regex.Applicative as RE import Text.Regex.TDFA ((=~), (=~~)) ------------------------------------------------------------------------------------------------- diff --git a/plugins/hls-refactor-plugin/src/Development/IDE/Plugin/CodeAction/ExactPrint.hs b/plugins/hls-refactor-plugin/src/Development/IDE/Plugin/CodeAction/ExactPrint.hs index 10327423e6..54aaf35308 100644 --- a/plugins/hls-refactor-plugin/src/Development/IDE/Plugin/CodeAction/ExactPrint.hs +++ b/plugins/hls-refactor-plugin/src/Development/IDE/Plugin/CodeAction/ExactPrint.hs @@ -1,5 +1,5 @@ -{-# LANGUAGE TypeFamilies #-} {-# LANGUAGE GADTs #-} +{-# LANGUAGE TypeFamilies #-} module Development.IDE.Plugin.CodeAction.ExactPrint ( Rewrite (..), rewriteToEdit, @@ -17,35 +17,40 @@ module Development.IDE.Plugin.CodeAction.ExactPrint ( import Control.Monad import Control.Monad.Trans -import Data.Char (isAlphaNum) -import Data.Data (Data) -import Data.Generics (listify) -import qualified Data.Text as T -import Development.IDE.GHC.Compat hiding (Annotation) +import Data.Char (isAlphaNum) +import Data.Data (Data) +import Data.Generics (listify) +import qualified Data.Text as T +import Development.IDE.GHC.Compat hiding (Annotation) import Development.IDE.GHC.Error import Development.IDE.GHC.ExactPrint import Development.IDE.GHC.Util import Development.IDE.Spans.Common -import GHC.Exts (IsList (fromList)) -import GHC.Stack (HasCallStack) +import GHC.Exts (IsList (fromList)) +import GHC.Stack (HasCallStack) import Language.Haskell.GHC.ExactPrint import Language.LSP.Protocol.Types import Development.IDE.Plugin.CodeAction.Util -- GHC version specific imports. For any supported GHC version, make sure there is no warning in imports. -import Control.Lens (_head, _last, over) -import Data.Bifunctor (first) -import Data.Default (Default (..)) -import Data.Maybe (fromJust, fromMaybe, mapMaybe) -import GHC (AddEpAnn (..), AnnContext (..), AnnList (..), - AnnParen (..), DeltaPos (SameLine), EpAnn (..), - EpaLocation (EpaDelta), - IsUnicodeSyntax (NormalSyntax), - NameAdornment (NameParens), - TrailingAnn (AddCommaAnn), addAnns, ann, - emptyComments, noSrcSpanA, reAnnL) -import Language.Haskell.GHC.ExactPrint.ExactPrint (makeDeltaAst, showAst) +import Control.Lens (_head, _last, over) +import Data.Bifunctor (first) +import Data.Default (Default (..)) +import Data.Maybe (fromJust, fromMaybe, + mapMaybe) +import GHC (AddEpAnn (..), + AnnContext (..), + AnnList (..), + AnnParen (..), + DeltaPos (SameLine), + EpAnn (..), + EpaLocation (EpaDelta), + IsUnicodeSyntax (NormalSyntax), + NameAdornment (NameParens), + TrailingAnn (AddCommaAnn), + addAnns, ann, + emptyComments, reAnnL) ------------------------------------------------------------------------------ diff --git a/plugins/hls-refactor-plugin/src/Development/IDE/Plugin/Plugins/AddArgument.hs b/plugins/hls-refactor-plugin/src/Development/IDE/Plugin/Plugins/AddArgument.hs index fcec3b2887..17488b44a7 100644 --- a/plugins/hls-refactor-plugin/src/Development/IDE/Plugin/Plugins/AddArgument.hs +++ b/plugins/hls-refactor-plugin/src/Development/IDE/Plugin/Plugins/AddArgument.hs @@ -1,10 +1,6 @@ {-# LANGUAGE CPP #-} module Development.IDE.Plugin.Plugins.AddArgument (plugin) where -#if MIN_VERSION_ghc(9,4,0) -import Development.IDE.GHC.ExactPrint (epl) -import GHC.Parser.Annotation (TokenLocation (..)) -#endif import Control.Monad (join) import Control.Monad.Trans.Class (lift) import Data.Bifunctor (Bifunctor (..)) @@ -23,19 +19,27 @@ import GHC (EpAnn (..), SrcSpanAnn' (SrcSpanAnn), SrcSpanAnnA, SrcSpanAnnN, - TrailingAnn (..), emptyComments, noAnn) -import GHC.Hs (IsUnicodeSyntax (..)) import GHC.Types.SrcLoc (generatedSrcSpan) import Ide.Plugin.Error (PluginError (PluginInternalError)) import Ide.PluginUtils (makeDiffTextEdit) import Language.Haskell.GHC.ExactPrint (TransformT (..), noAnnSrcSpanDP1, runTransformT) -import Language.Haskell.GHC.ExactPrint.Transform (d1) import Language.LSP.Protocol.Types +#if !MIN_VERSION_ghc(9,4,0) +import GHC (TrailingAnn (..)) +import GHC.Hs (IsUnicodeSyntax (..)) +import Language.Haskell.GHC.ExactPrint.Transform (d1) +#endif + +#if MIN_VERSION_ghc(9,4,0) +import Development.IDE.GHC.ExactPrint (epl) +import GHC.Parser.Annotation (TokenLocation (..)) +#endif + -- When GHC tells us that a variable is not bound, it will tell us either: -- - there is an unbound variable with a given type -- - there is an unbound variable (GHC provides no type suggestion) diff --git a/plugins/hls-rename-plugin/src/Ide/Plugin/Rename.hs b/plugins/hls-rename-plugin/src/Ide/Plugin/Rename.hs index e9fb9b6624..2220306c13 100644 --- a/plugins/hls-rename-plugin/src/Ide/Plugin/Rename.hs +++ b/plugins/hls-rename-plugin/src/Ide/Plugin/Rename.hs @@ -7,16 +7,12 @@ module Ide.Plugin.Rename (descriptor, E.Log) where -import GHC.Parser.Annotation (AnnContext, AnnList, - AnnParen, AnnPragma) - import Compat.HieTypes import Control.Lens ((^.)) import Control.Monad -import Control.Monad.Except -import Control.Monad.IO.Class -import Control.Monad.Trans.Class -import Control.Monad.Trans.Except +import Control.Monad.Except (ExceptT, throwError) +import Control.Monad.IO.Class (MonadIO, liftIO) +import Control.Monad.Trans.Class (lift) import Data.Bifunctor (first) import Data.Generics import Data.Hashable diff --git a/plugins/hls-rename-plugin/test/Main.hs b/plugins/hls-rename-plugin/test/Main.hs index 1d45c1e6f2..2a34ab1a43 100644 --- a/plugins/hls-rename-plugin/test/Main.hs +++ b/plugins/hls-rename-plugin/test/Main.hs @@ -6,7 +6,6 @@ import Data.Aeson import qualified Data.Map as M import Ide.Plugin.Config import qualified Ide.Plugin.Rename as Rename -import Ide.Types (IdePlugins (IdePlugins)) import System.FilePath import Test.Hls diff --git a/plugins/hls-retrie-plugin/src/Ide/Plugin/Retrie.hs b/plugins/hls-retrie-plugin/src/Ide/Plugin/Retrie.hs index 6e5d3d6962..4125ded8e0 100644 --- a/plugins/hls-retrie-plugin/src/Ide/Plugin/Retrie.hs +++ b/plugins/hls-retrie-plugin/src/Ide/Plugin/Retrie.hs @@ -23,30 +23,23 @@ import Control.Monad.IO.Class (MonadIO (liftIO)) import Control.Monad.Trans.Class (MonadTrans (lift)) import Control.Monad.Trans.Except (ExceptT (..), runExceptT) -import Control.Monad.Trans.Maybe -import Control.Monad.Trans.Writer.Strict import Data.Aeson (FromJSON (..), - ToJSON (..), Value) + ToJSON (..)) import Data.Bifunctor (second) import qualified Data.ByteString as BS import Data.Coerce import Data.Data import Data.Either (partitionEithers) -import Data.Hashable (Hashable (hash), - unhashed) -import qualified Data.HashMap.Strict as HM +import Data.Hashable (unhashed) import qualified Data.HashSet as Set import Data.IORef.Extra (atomicModifyIORef'_, newIORef, readIORef) import Data.List.Extra (find, nubOrdOn) import qualified Data.Map as Map -import Data.Maybe (catMaybes, fromJust, - listToMaybe) +import Data.Maybe (catMaybes) import Data.String (IsString) import qualified Data.Text as T import qualified Data.Text.Encoding as T -import Data.Typeable (Typeable) -import Debug.Trace import Development.IDE hiding (pluginHandlers) import Development.IDE.Core.PositionMapping import Development.IDE.Core.Shake (ShakeExtras (ShakeExtras, knownTargetsVar), @@ -56,7 +49,7 @@ import Development.IDE.Core.Shake (ShakeExtras (ShakeExtras, toKnownFiles, withHieDb) import Development.IDE.GHC.Compat (GRHSs (GRHSs), GenLocated (L), GhcPs, - GhcRn, GhcTc, + GhcRn, HsBindLR (FunBind), HsExpr (HsApp, OpApp), HsGroup (..), @@ -66,18 +59,14 @@ import Development.IDE.GHC.Compat (GRHSs (GRHSs), LRuleDecls, Match, ModIface, ModSummary (ModSummary, ms_hspp_buf, ms_mod), - Name, Outputable, - ParsedModule (..), - RealSrcLoc, + Outputable, ParsedModule, RuleDecl (HsRule), RuleDecls (HsRules), SourceText (..), TyClDecl (SynDecl), TyClGroup (..), fun_id, - hm_iface, isQual, - isQual_maybe, isVarOcc, + isQual, isQual_maybe, locA, mi_fixities, - moduleName, moduleNameString, ms_hspp_opts, nameModule_maybe, @@ -88,21 +77,13 @@ import Development.IDE.GHC.Compat (GRHSs (GRHSs), pattern NotBoot, pattern RealSrcSpan, pm_parsed_source, - printWithoutUniques, rdrNameOcc, rds_rules, srcSpanFile, topDir, unLoc, unLocA) import qualified Development.IDE.GHC.Compat as GHC import Development.IDE.GHC.Compat.Util hiding (catch, try) -import Development.IDE.GHC.Dump (showAstDataHtml) -import Development.IDE.GHC.ExactPrint (ExceptStringT (ExceptStringT), - GetAnnotatedParsedSource (GetAnnotatedParsedSource), - TransformT, - graftExprWithM, - graftSmallestDeclsWithM, - hoistGraft, transformM) -import qualified GHC (Module, ParsedSource, - moduleName, parseModule) +import Development.IDE.GHC.ExactPrint (GetAnnotatedParsedSource (GetAnnotatedParsedSource), + TransformT) import qualified GHC as GHCGHC import GHC.Generics (Generic) import GHC.Hs.Dump @@ -112,8 +93,7 @@ import Ide.Types import qualified Language.LSP.Protocol.Lens as L import Language.LSP.Protocol.Message as LSP import Language.LSP.Protocol.Types as LSP -import Language.LSP.Server (LspM, - ProgressCancellable (Cancellable), +import Language.LSP.Server (ProgressCancellable (Cancellable), sendNotification, sendRequest, withIndefiniteProgress) @@ -122,14 +102,13 @@ import Retrie (Annotated (astA), Fixity (Fixity), FixityDirection (InfixL), Options, Options_ (..), - RewriteSpec, Verbosity (Loud), addImports, apply, applyWithUpdate) import Retrie.Context import Retrie.CPP (CPP (NoCPP), parseCPP) -import Retrie.ExactPrint (Annotated, fix, - transformA, unsafeMkA) +import Retrie.ExactPrint (fix, transformA, + unsafeMkA) import Retrie.Expr (mkLocatedHsVar) import Retrie.Fixity (FixityEnv, lookupOp, mkFixityEnv) @@ -151,17 +130,13 @@ import System.Directory (makeAbsolute) import GHC.Types.PkgQual #endif -import Control.Arrow ((&&&)) -import Control.Exception (evaluate) import Data.Monoid (First (First)) import Development.IDE.Core.Actions (lookupMod) import Development.IDE.Core.PluginUtils import Development.IDE.Spans.AtPoint (LookupModule, - getNamesAtPoint, nameToLocation) import Development.IDE.Types.Shake (WithHieDb) import Retrie.ExactPrint (makeDeltaAst) -import Retrie.GHC (ann) descriptor :: PluginId -> PluginDescriptor IdeState descriptor plId = diff --git a/plugins/hls-retrie-plugin/test/Main.hs b/plugins/hls-retrie-plugin/test/Main.hs index 8696d3068a..a34e84e053 100644 --- a/plugins/hls-retrie-plugin/test/Main.hs +++ b/plugins/hls-retrie-plugin/test/Main.hs @@ -4,19 +4,15 @@ module Main (main) where -import Control.Concurrent (threadDelay) import Control.Monad (void) -import Data.Aeson import qualified Data.Map as M import Data.Text (Text) import qualified Development.IDE.GHC.ExactPrint import qualified Development.IDE.Plugin.CodeAction as Refactor import Ide.Plugin.Config import qualified Ide.Plugin.Retrie as Retrie -import Ide.Types (IdePlugins (IdePlugins)) import System.FilePath import Test.Hls -import Test.Hls (PluginTestDescriptor) main :: IO () main = defaultTestRunner tests diff --git a/plugins/hls-semantic-tokens-plugin/src/Ide/Plugin/SemanticTokens/Internal.hs b/plugins/hls-semantic-tokens-plugin/src/Ide/Plugin/SemanticTokens/Internal.hs index 958e6df0a9..7d2f37adac 100644 --- a/plugins/hls-semantic-tokens-plugin/src/Ide/Plugin/SemanticTokens/Internal.hs +++ b/plugins/hls-semantic-tokens-plugin/src/Ide/Plugin/SemanticTokens/Internal.hs @@ -17,7 +17,6 @@ import Control.Monad.Except (ExceptT, liftEither, withExceptT) import Control.Monad.Trans (lift) import Control.Monad.Trans.Except (runExceptT) -import Data.Map.Strict (Map) import qualified Data.Map.Strict as M import qualified Data.Set as S import Development.IDE (Action, @@ -30,8 +29,7 @@ import Development.IDE (Action, WithPriority, cmapWithPrio, define, fromNormalizedFilePath, - hieKind, logPriority, - use_) + hieKind, use_) import Development.IDE.Core.PluginUtils (runActionE, useWithStaleE) import Development.IDE.Core.PositionMapping (idDelta) diff --git a/plugins/hls-semantic-tokens-plugin/src/Ide/Plugin/SemanticTokens/Tokenize.hs b/plugins/hls-semantic-tokens-plugin/src/Ide/Plugin/SemanticTokens/Tokenize.hs index 0f98a6ceed..4718fd6458 100644 --- a/plugins/hls-semantic-tokens-plugin/src/Ide/Plugin/SemanticTokens/Tokenize.hs +++ b/plugins/hls-semantic-tokens-plugin/src/Ide/Plugin/SemanticTokens/Tokenize.hs @@ -9,7 +9,7 @@ import Control.Monad.State.Strict (MonadState (get), MonadTrans (lift), execStateT, modify, put) import Control.Monad.Trans.State.Strict (StateT) -import Data.Char (isAlpha, isAlphaNum) +import Data.Char (isAlphaNum) import qualified Data.Map.Strict as M import qualified Data.Map.Strict as Map import qualified Data.Set as S