From b1dceaa104d0b5e84b49a64504aa7fdfc95d18c5 Mon Sep 17 00:00:00 2001 From: Pepe Iborra Date: Sun, 21 Feb 2021 10:50:57 +0000 Subject: [PATCH] Fix the handling of default HLS config again Two mis-uses of def introduced in the lsp-1.0 migration --- ghcide/src/Development/IDE.hs | 80 ++++++++++--------- ghcide/src/Development/IDE/Core/Service.hs | 24 +++--- ghcide/src/Development/IDE/Core/Shake.hs | 19 ++++- ghcide/src/Development/IDE/Main.hs | 5 +- .../src/Development/IDE/Plugin/Completions.hs | 70 ++++++++-------- ghcide/src/Development/IDE/Plugin/HLS.hs | 69 ++++++++-------- hls-plugin-api/src/Ide/PluginUtils.hs | 25 +++--- .../src/Ide/Plugin/Tactic.hs | 34 ++++---- .../src/Ide/Plugin/Tactic/LanguageServer.hs | 58 +++++++------- 9 files changed, 204 insertions(+), 180 deletions(-) diff --git a/ghcide/src/Development/IDE.hs b/ghcide/src/Development/IDE.hs index e3b7f8407a..c11762692d 100644 --- a/ghcide/src/Development/IDE.hs +++ b/ghcide/src/Development/IDE.hs @@ -6,41 +6,45 @@ module Development.IDE ) where -import Development.IDE.Core.RuleTypes as X -import Development.IDE.Core.Rules as X - (getAtPoint - ,getClientConfigAction - ,getDefinition - ,getParsedModule - ,getTypeDefinition - ) -import Development.IDE.Core.FileExists as X - (getFileExists) -import Development.IDE.Core.FileStore as X - (getFileContents) -import Development.IDE.Core.IdeConfiguration as X - (IdeConfiguration(..) - ,isWorkspaceFile) -import Development.IDE.Core.OfInterest as X (getFilesOfInterest) -import Development.IDE.Core.Service as X (runAction) -import Development.IDE.Core.Shake as X - ( IdeState, - shakeExtras, - ShakeExtras, - IdeRule, - define, defineEarlyCutoff, - use, useNoFile, uses, useWithStale, useWithStaleFast, useWithStaleFast', - FastResult(..), - use_, useNoFile_, uses_, useWithStale_, - ideLogger, - actionLogger, - IdeAction(..), runIdeAction - ) -import Development.IDE.GHC.Error as X -import Development.IDE.GHC.Util as X -import Development.IDE.Plugin as X -import Development.IDE.Types.Diagnostics as X -import Development.IDE.Types.HscEnvEq as X (HscEnvEq(..), hscEnv, hscEnvWithImportPaths) -import Development.IDE.Types.Location as X -import Development.IDE.Types.Logger as X -import Development.Shake as X (Action, action, Rules, RuleResult) +import Development.IDE.Core.FileExists as X (getFileExists) +import Development.IDE.Core.FileStore as X (getFileContents) +import Development.IDE.Core.IdeConfiguration as X (IdeConfiguration (..), + isWorkspaceFile) +import Development.IDE.Core.OfInterest as X (getFilesOfInterest) +import Development.IDE.Core.RuleTypes as X +import Development.IDE.Core.Rules as X (getAtPoint, + getClientConfigAction, + getDefinition, + getParsedModule, + getTypeDefinition) +import Development.IDE.Core.Service as X (runAction) +import Development.IDE.Core.Shake as X (FastResult (..), + IdeAction (..), + IdeRule, IdeState, + ShakeExtras, + actionLogger, + define, + defineEarlyCutoff, + getClientConfig, + getPluginConfig, + ideLogger, + runIdeAction, + shakeExtras, use, + useNoFile, + useNoFile_, + useWithStale, + useWithStaleFast, + useWithStaleFast', + useWithStale_, + use_, uses, uses_) +import Development.IDE.GHC.Error as X +import Development.IDE.GHC.Util as X +import Development.IDE.Plugin as X +import Development.IDE.Types.Diagnostics as X +import Development.IDE.Types.HscEnvEq as X (HscEnvEq (..), + hscEnv, + hscEnvWithImportPaths) +import Development.IDE.Types.Location as X +import Development.IDE.Types.Logger as X +import Development.Shake as X (Action, RuleResult, + Rules, action) diff --git a/ghcide/src/Development/IDE/Core/Service.hs b/ghcide/src/Development/IDE/Core/Service.hs index c105285158..ae30b0c587 100644 --- a/ghcide/src/Development/IDE/Core/Service.hs +++ b/ghcide/src/Development/IDE/Core/Service.hs @@ -1,9 +1,9 @@ -- Copyright (c) 2019 The DAML Authors. All rights reserved. -- SPDX-License-Identifier: Apache-2.0 -{-# LANGUAGE TypeFamilies #-} {-# LANGUAGE FlexibleInstances #-} -{-# LANGUAGE RankNTypes #-} +{-# LANGUAGE RankNTypes #-} +{-# LANGUAGE TypeFamilies #-} -- | A Shake implementation of the compiler service, built -- using the "Shaker" abstraction layer for in-memory use. @@ -18,26 +18,27 @@ module Development.IDE.Core.Service( updatePositionMapping, ) where -import Development.IDE.Types.Options (IdeOptions(..)) -import Development.IDE.Core.Debouncer -import Development.IDE.Core.FileStore (fileStoreRules) +import Development.IDE.Core.Debouncer import Development.IDE.Core.FileExists (fileExistsRules) +import Development.IDE.Core.FileStore (fileStoreRules) import Development.IDE.Core.OfInterest -import Development.IDE.Types.Logger as Logger +import Development.IDE.Types.Logger as Logger +import Development.IDE.Types.Options (IdeOptions (..)) import Development.Shake -import qualified Language.LSP.Server as LSP -import qualified Language.LSP.Types as LSP import Ide.Plugin.Config +import qualified Language.LSP.Server as LSP +import qualified Language.LSP.Types as LSP +import Control.Monad import Development.IDE.Core.Shake -import Control.Monad ------------------------------------------------------------ -- Exposed API -- | Initialise the Compiler Service. -initialise :: Rules () +initialise :: Config + -> Rules () -> Maybe (LSP.LanguageContextEnv Config) -> Logger -> Debouncer LSP.NormalizedUri @@ -46,9 +47,10 @@ initialise :: Rules () -> HieDb -> IndexQueue -> IO IdeState -initialise mainRule lspEnv logger debouncer options vfs hiedb hiedbChan = +initialise defaultConfig mainRule lspEnv logger debouncer options vfs hiedb hiedbChan = shakeOpen lspEnv + defaultConfig logger debouncer (optShakeProfiling options) diff --git a/ghcide/src/Development/IDE/Core/Shake.hs b/ghcide/src/Development/IDE/Core/Shake.hs index e874e1fcc7..868953181b 100644 --- a/ghcide/src/Development/IDE/Core/Shake.hs +++ b/ghcide/src/Development/IDE/Core/Shake.hs @@ -47,6 +47,8 @@ module Development.IDE.Core.Shake( getIdeOptions, getIdeOptionsIO, GlobalIdeOptions(..), + getClientConfig, + getPluginConfig, garbageCollect, knownTargets, setPriority, @@ -140,6 +142,8 @@ import Control.Exception.Extra hiding (bracket_) import UnliftIO.Exception (bracket_) import Ide.Plugin.Config import Data.Default +import qualified Ide.PluginUtils as HLS +import Ide.Types ( PluginId ) -- | We need to serialize writes to the database, so we send any function that -- needs to write to the database over the channel, where it will be picked up by @@ -196,6 +200,8 @@ data ShakeExtras = ShakeExtras -- ^ Registery for functions that compute/get "stale" results for the rule -- (possibly from disk) , vfs :: VFSHandle + , defaultConfig :: Config + -- ^ Default HLS config, only relevant if the client does not provide any Config } type WithProgressFunc = forall a. @@ -219,6 +225,16 @@ getShakeExtrasRules = do Just x <- getShakeExtraRules @ShakeExtras return x +getClientConfig :: LSP.MonadLsp Config m => ShakeExtras -> m Config +getClientConfig ShakeExtras { defaultConfig } = + fromMaybe defaultConfig <$> HLS.getClientConfig + +getPluginConfig + :: LSP.MonadLsp Config m => ShakeExtras -> PluginId -> m PluginConfig +getPluginConfig extras plugin = do + config <- getClientConfig extras + return $ HLS.configForPlugin config plugin + -- | Register a function that will be called to get the "stale" result of a rule, possibly from disk -- This is called when we don't already have a result, or computing the rule failed. -- The result of this function will always be marked as 'stale', and a 'proper' rebuild of the rule will @@ -445,6 +461,7 @@ seqValue v b = case v of -- | Open a 'IdeState', should be shut using 'shakeShut'. shakeOpen :: Maybe (LSP.LanguageContextEnv Config) + -> Config -> Logger -> Debouncer NormalizedUri -> Maybe FilePath @@ -456,7 +473,7 @@ shakeOpen :: Maybe (LSP.LanguageContextEnv Config) -> ShakeOptions -> Rules () -> IO IdeState -shakeOpen lspEnv logger debouncer +shakeOpen lspEnv defaultConfig logger debouncer shakeProfileDir (IdeReportProgress reportProgress) ideTesting@(IdeTesting testing) hiedb indexQueue vfs opts rules = mdo inProgress <- newVar HMap.empty diff --git a/ghcide/src/Development/IDE/Main.hs b/ghcide/src/Development/IDE/Main.hs index 8cd06f14a5..b2ea0c4893 100644 --- a/ghcide/src/Development/IDE/Main.hs +++ b/ghcide/src/Development/IDE/Main.hs @@ -104,7 +104,7 @@ defaultMain :: Arguments -> IO () defaultMain Arguments{..} = do pid <- T.pack . show <$> getProcessID - let hlsPlugin = asGhcIdePlugin argsHlsPlugins + let hlsPlugin = asGhcIdePlugin argsDefaultHlsConfig argsHlsPlugins hlsCommands = allLspCmdIds' pid argsHlsPlugins plugins = hlsPlugin <> argsGhcidePlugin options = argsLspOptions { LSP.executeCommandCommands = Just hlsCommands } @@ -138,6 +138,7 @@ defaultMain Arguments{..} = do caps = LSP.resClientCapabilities env debouncer <- newAsyncDebouncer initialise + argsDefaultHlsConfig rules (Just env) argsLogger @@ -177,7 +178,7 @@ defaultMain Arguments{..} = do { optCheckParents = pure NeverCheck , optCheckProject = pure False } - ide <- initialise rules Nothing argsLogger debouncer options vfs hiedb hieChan + ide <- initialise argsDefaultHlsConfig rules Nothing argsLogger debouncer options vfs hiedb hieChan putStrLn "\nStep 4/4: Type checking the files" setFilesOfInterest ide $ HashMap.fromList $ map ((,OnDisk) . toNormalizedFilePath') files diff --git a/ghcide/src/Development/IDE/Plugin/Completions.hs b/ghcide/src/Development/IDE/Plugin/Completions.hs index 51a61075e7..9f4e89a1b9 100644 --- a/ghcide/src/Development/IDE/Plugin/Completions.hs +++ b/ghcide/src/Development/IDE/Plugin/Completions.hs @@ -9,38 +9,38 @@ module Development.IDE.Plugin.Completions , NonLocalCompletions(..) ) where -import Control.Monad -import Control.Monad.Extra -import Control.Monad.Trans.Maybe -import Data.Aeson -import Data.List (find) -import Data.Maybe -import qualified Data.Text as T -import Language.LSP.Types -import qualified Language.LSP.Server as LSP -import qualified Language.LSP.VFS as VFS -import Development.Shake.Classes -import Development.Shake -import GHC.Generics -import Development.IDE.Core.Service -import Development.IDE.Core.PositionMapping -import Development.IDE.Plugin.Completions.Logic -import Development.IDE.Types.Location -import Development.IDE.Core.RuleTypes -import Development.IDE.Core.Shake -import Development.IDE.GHC.Compat -import Development.IDE.GHC.ExactPrint (Annotated (annsA), GetAnnotatedParsedSource (GetAnnotatedParsedSource)) -import Development.IDE.Types.HscEnvEq (hscEnv) -import Development.IDE.Plugin.CodeAction.ExactPrint -import Development.IDE.Plugin.Completions.Types -import Ide.Plugin.Config (Config (completionSnippetsOn)) -import Ide.PluginUtils (getClientConfig) -import Ide.Types -import TcRnDriver (tcRnImportDecls) -import Control.Concurrent.Async (concurrently) -import GHC.Exts (toList) -import Development.IDE.GHC.Error (rangeToSrcSpan) -import Development.IDE.GHC.Util (prettyPrint) +import Control.Concurrent.Async (concurrently) +import Control.Monad +import Control.Monad.Extra +import Control.Monad.Trans.Maybe +import Data.Aeson +import Data.List (find) +import Data.Maybe +import qualified Data.Text as T +import Development.IDE.Core.PositionMapping +import Development.IDE.Core.RuleTypes +import Development.IDE.Core.Service +import Development.IDE.Core.Shake +import Development.IDE.GHC.Compat +import Development.IDE.GHC.Error (rangeToSrcSpan) +import Development.IDE.GHC.ExactPrint (Annotated (annsA), + GetAnnotatedParsedSource (GetAnnotatedParsedSource)) +import Development.IDE.GHC.Util (prettyPrint) +import Development.IDE.Plugin.CodeAction.ExactPrint +import Development.IDE.Plugin.Completions.Logic +import Development.IDE.Plugin.Completions.Types +import Development.IDE.Types.HscEnvEq (hscEnv) +import Development.IDE.Types.Location +import Development.Shake +import Development.Shake.Classes +import GHC.Exts (toList) +import GHC.Generics +import Ide.Plugin.Config (Config (completionSnippetsOn)) +import Ide.Types +import qualified Language.LSP.Server as LSP +import Language.LSP.Types +import qualified Language.LSP.VFS as VFS +import TcRnDriver (tcRnImportDecls) descriptor :: PluginId -> PluginDescriptor IdeState descriptor plId = (defaultPluginDescriptor plId) @@ -86,7 +86,7 @@ dropListFromImportDecl iDecl = let f d@ImportDecl {ideclHiding} = case ideclHiding of Just (False, _) -> d {ideclHiding=Nothing} -- if hiding or Nothing just return d - _ -> d + _ -> d f x = x in f <$> iDecl @@ -135,7 +135,7 @@ getCompletionsLSP ide plId -> return (InL $ List []) (Just pfix', _) -> do let clientCaps = clientCapabilities $ shakeExtras ide - config <- getClientConfig + config <- getClientConfig $ shakeExtras ide let snippets = WithSnippets . completionSnippetsOn $ config allCompletions <- liftIO $ getCompletions plId ideOpts cci' parsedMod bindMap pfix' clientCaps snippets pure $ InL (List allCompletions) @@ -200,5 +200,5 @@ liftMaybe :: Monad m => Maybe a -> MaybeT m a liftMaybe a = MaybeT $ pure a liftEither :: Monad m => Either e a -> MaybeT m a -liftEither (Left _) = mzero +liftEither (Left _) = mzero liftEither (Right x) = return x diff --git a/ghcide/src/Development/IDE/Plugin/HLS.hs b/ghcide/src/Development/IDE/Plugin/HLS.hs index 1cb03b8116..2113a38b77 100644 --- a/ghcide/src/Development/IDE/Plugin/HLS.hs +++ b/ghcide/src/Development/IDE/Plugin/HLS.hs @@ -1,49 +1,50 @@ +{-# LANGUAGE GADTs #-} {-# LANGUAGE PolyKinds #-} -{-# LANGUAGE GADTs #-} module Development.IDE.Plugin.HLS ( asGhcIdePlugin ) where -import Control.Exception(SomeException) +import Control.Exception (SomeException) import Control.Monad -import qualified Data.Aeson as J +import qualified Data.Aeson as J +import Data.Bifunctor +import Data.Dependent.Map (DMap) +import qualified Data.Dependent.Map as DMap +import Data.Dependent.Sum import Data.Either -import qualified Data.List as List -import qualified Data.Map as Map -import qualified Data.Text as T +import qualified Data.List as List +import Data.List.NonEmpty (NonEmpty, nonEmpty, toList) +import qualified Data.Map as Map +import Data.Maybe (fromMaybe) +import Data.String +import qualified Data.Text as T import Development.IDE.Core.Shake +import Development.IDE.Core.Tracing import Development.IDE.LSP.Server import Development.IDE.Plugin +import Development.Shake (Rules) import Ide.Plugin.Config -import Ide.Types as HLS -import qualified Language.LSP.Server as LSP -import qualified Language.LSP.Types as J -import Language.LSP.Types -import Text.Regex.TDFA.Text() -import Development.Shake (Rules) -import Ide.PluginUtils (getClientConfig) -import Development.IDE.Core.Tracing -import UnliftIO.Async (forConcurrently) -import UnliftIO.Exception (catchAny) -import Data.Dependent.Map (DMap) -import qualified Data.Dependent.Map as DMap -import Data.Dependent.Sum -import Data.List.NonEmpty (nonEmpty,NonEmpty,toList) -import UnliftIO (MonadUnliftIO) -import Data.String -import Data.Bifunctor +import Ide.PluginUtils (getClientConfig) +import Ide.Types as HLS +import qualified Language.LSP.Server as LSP +import Language.LSP.Types +import qualified Language.LSP.Types as J +import Text.Regex.TDFA.Text () +import UnliftIO (MonadUnliftIO) +import UnliftIO.Async (forConcurrently) +import UnliftIO.Exception (catchAny) -- --------------------------------------------------------------------- -- -- | Map a set of plugins to the underlying ghcide engine. -asGhcIdePlugin :: IdePlugins IdeState -> Plugin Config -asGhcIdePlugin mp = - mkPlugin rulesPlugins HLS.pluginRules <> +asGhcIdePlugin :: Config -> IdePlugins IdeState -> Plugin Config +asGhcIdePlugin defaultConfig mp = + mkPlugin rulesPlugins HLS.pluginRules <> mkPlugin executeCommandPlugins HLS.pluginCommands <> - mkPlugin extensiblePlugins HLS.pluginHandlers + mkPlugin (extensiblePlugins defaultConfig) HLS.pluginHandlers where ls = Map.toList (ipMap mp) @@ -75,9 +76,9 @@ executeCommandHandlers ecs = requestHandler SWorkspaceExecuteCommand execCmd parseCmdId :: T.Text -> Maybe (PluginId, CommandId) parseCmdId x = case T.splitOn ":" x of - [plugin, command] -> Just (PluginId plugin, CommandId command) + [plugin, command] -> Just (PluginId plugin, CommandId command) [_, plugin, command] -> Just (PluginId plugin, CommandId command) - _ -> Nothing + _ -> Nothing -- The parameters to the HLS command are always the first element @@ -85,7 +86,7 @@ executeCommandHandlers ecs = requestHandler SWorkspaceExecuteCommand execCmd let cmdParams :: J.Value cmdParams = case args of Just (J.List (x:_)) -> x - _ -> J.Null + _ -> J.Null case parseCmdId cmdId of -- Shortcut for immediately applying a applyWorkspaceEdit as a fallback for v3.8 code actions Just ("hls", "fallbackCodeAction") -> @@ -127,8 +128,8 @@ executeCommandHandlers ecs = requestHandler SWorkspaceExecuteCommand execCmd -- --------------------------------------------------------------------- -extensiblePlugins :: [(PluginId, PluginHandlers IdeState)] -> Plugin Config -extensiblePlugins xs = Plugin mempty handlers +extensiblePlugins :: Config -> [(PluginId, PluginHandlers IdeState)] -> Plugin Config +extensiblePlugins defaultConfig xs = Plugin mempty handlers where IdeHandlers handlers' = foldMap bakePluginId xs bakePluginId :: (PluginId, PluginHandlers IdeState) -> IdeHandlers @@ -138,7 +139,7 @@ extensiblePlugins xs = Plugin mempty handlers handlers = mconcat $ do (IdeMethod m :=> IdeHandler fs') <- DMap.assocs handlers' pure $ requestHandler m $ \ide params -> do - config <- getClientConfig + config <- fromMaybe defaultConfig <$> Ide.PluginUtils.getClientConfig let fs = filter (\(pid,_) -> pluginEnabled m pid config) fs' case nonEmpty fs of Nothing -> pure $ Left $ ResponseError InvalidRequest @@ -168,7 +169,7 @@ runConcurrently msg method fs a b = fmap join $ forConcurrently fs $ \(pid,f) -> combineErrors :: [ResponseError] -> ResponseError combineErrors [x] = x -combineErrors xs = ResponseError InternalError (T.pack (show xs)) Nothing +combineErrors xs = ResponseError InternalError (T.pack (show xs)) Nothing -- | Combine the 'PluginHandler' for all plugins newtype IdeHandler (m :: J.Method FromClient Request) diff --git a/hls-plugin-api/src/Ide/PluginUtils.hs b/hls-plugin-api/src/Ide/PluginUtils.hs index 00ff4fd550..1742d2c2ea 100644 --- a/hls-plugin-api/src/Ide/PluginUtils.hs +++ b/hls-plugin-api/src/Ide/PluginUtils.hs @@ -1,5 +1,5 @@ +{-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE OverloadedStrings #-} -{-# LANGUAGE FlexibleContexts #-} module Ide.PluginUtils ( WithDeletions(..), getProcessID, @@ -25,18 +25,16 @@ where import Data.Algorithm.Diff import Data.Algorithm.DiffOutput -import qualified Data.HashMap.Strict as H -import Data.Maybe -import qualified Data.Text as T +import qualified Data.HashMap.Strict as H +import qualified Data.Text as T import Ide.Types import Language.LSP.Types import qualified Language.LSP.Types as J import Language.LSP.Types.Capabilities -import qualified Data.Default -import qualified Data.Map.Strict as Map +import qualified Data.Map.Strict as Map import Ide.Plugin.Config -import Language.LSP.Server +import Language.LSP.Server -- --------------------------------------------------------------------- @@ -148,23 +146,18 @@ pluginDescToIdePlugins plugins = IdePlugins $ Map.fromList $ map (\p -> (pluginI -- cache the returned value of this function, as clients can at runitime change -- their configuration. -- --- If no custom configuration has been set by the client, this function returns --- our own defaults. -getClientConfig :: MonadLsp Config m => m Config -getClientConfig = fromMaybe Data.Default.def <$> getConfig +getClientConfig :: MonadLsp Config m => m (Maybe Config) +getClientConfig = getConfig -- --------------------------------------------------------------------- -- | Returns the current plugin configuration. It is not wise to permanently -- cache the returned value of this function, as clients can change their -- configuration at runtime. --- --- If no custom configuration has been set by the client, this function returns --- our own defaults. -getPluginConfig :: MonadLsp Config m => PluginId -> m PluginConfig +getPluginConfig :: MonadLsp Config m => PluginId -> m (Maybe PluginConfig) getPluginConfig plugin = do config <- getClientConfig - return $ configForPlugin config plugin + return $ flip configForPlugin plugin <$> config -- --------------------------------------------------------------------- diff --git a/plugins/hls-tactics-plugin/src/Ide/Plugin/Tactic.hs b/plugins/hls-tactics-plugin/src/Ide/Plugin/Tactic.hs index eff9e5efab..1a909649e6 100644 --- a/plugins/hls-tactics-plugin/src/Ide/Plugin/Tactic.hs +++ b/plugins/hls-tactics-plugin/src/Ide/Plugin/Tactic.hs @@ -13,27 +13,29 @@ module Ide.Plugin.Tactic , TacticCommand (..) ) where -import Bag (listToBag, bagToList) -import Control.Exception (evaluate) +import Bag (bagToList, + listToBag) +import Control.Exception (evaluate) import Control.Monad import Control.Monad.Trans import Control.Monad.Trans.Maybe import Data.Aeson -import Data.Bifunctor (Bifunctor(bimap)) -import Data.Bool (bool) -import Data.Data (Data) -import Data.Generics.Aliases (mkQ) -import Data.Generics.Schemes (everything) +import Data.Bifunctor (Bifunctor (bimap)) +import Data.Bool (bool) +import Data.Data (Data) +import Data.Generics.Aliases (mkQ) +import Data.Generics.Schemes (everything) import Data.Maybe import Data.Monoid -import qualified Data.Text as T +import qualified Data.Text as T import Data.Traversable -import Development.IDE.Core.Shake (IdeState (..)) +import Development.IDE.Core.Shake (IdeState (..)) import Development.IDE.GHC.Compat import Development.IDE.GHC.ExactPrint import Development.Shake.Classes import Ide.Plugin.Tactic.CaseSplit -import Ide.Plugin.Tactic.FeatureSet (hasFeature, Feature (..)) +import Ide.Plugin.Tactic.FeatureSet (Feature (..), + hasFeature) import Ide.Plugin.Tactic.GHC import Ide.Plugin.Tactic.LanguageServer import Ide.Plugin.Tactic.LanguageServer.TacticProviders @@ -46,7 +48,7 @@ import Language.LSP.Server import Language.LSP.Types import Language.LSP.Types.Capabilities import OccName -import Prelude hiding (span) +import Prelude hiding (span) import System.Timeout @@ -68,7 +70,7 @@ descriptor plId = (defaultPluginDescriptor plId) codeActionProvider :: PluginMethodHandler IdeState TextDocumentCodeAction codeActionProvider state plId (CodeActionParams _ _ (TextDocumentIdentifier uri) range _ctx) | Just nfp <- uriToNormalizedFilePath $ toNormalizedUri uri = do - features <- getFeatureSet + features <- getFeatureSet (shakeExtras state) liftIO $ fromMaybeT (Right $ List []) $ do (_, jdg, _, dflags) <- judgementForHole state nfp range features actions <- lift $ @@ -87,7 +89,7 @@ codeActionProvider _ _ _ = pure $ Right $ List [] tacticCmd :: (OccName -> TacticsM ()) -> CommandFunction IdeState TacticParams tacticCmd tac state (TacticParams uri range var_name) | Just nfp <- uriToNormalizedFilePath $ toNormalizedUri uri = do - features <- getFeatureSet + features <- getFeatureSet (shakeExtras state) ccs <- getClientCapabilities res <- liftIO $ fromMaybeT (Right Nothing) $ do (range', jdg, ctx, dflags) <- judgementForHole state nfp range features @@ -126,7 +128,7 @@ mkErr code err = ResponseError code err Nothing joinNote :: e -> Maybe (Either e a) -> Either e a -joinNote e Nothing = Left e +joinNote e Nothing = Left e joinNote _ (Just a) = a @@ -146,7 +148,7 @@ mkWorkspaceEdits span dflags ccs uri pm rtr = do response = transform dflags ccs uri g pm in case response of Right res -> Right $ Just res - Left err -> Left $ mkErr InternalError $ T.pack err + Left err -> Left $ mkErr InternalError $ T.pack err ------------------------------------------------------------------------------ @@ -257,7 +259,7 @@ locateBiggest :: (Data r, Data a) => SrcSpan -> a -> Maybe r locateBiggest ss x = getFirst $ everything (<>) ( mkQ mempty $ \case L span r | ss `isSubspanOf` span -> pure r - _ -> mempty + _ -> mempty ) x diff --git a/plugins/hls-tactics-plugin/src/Ide/Plugin/Tactic/LanguageServer.hs b/plugins/hls-tactics-plugin/src/Ide/Plugin/Tactic/LanguageServer.hs index c81ccf549d..1c672116e1 100644 --- a/plugins/hls-tactics-plugin/src/Ide/Plugin/Tactic/LanguageServer.hs +++ b/plugins/hls-tactics-plugin/src/Ide/Plugin/Tactic/LanguageServer.hs @@ -1,4 +1,4 @@ -{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE GADTs #-} {-# LANGUAGE LambdaCase #-} {-# LANGUAGE OverloadedStrings #-} @@ -9,45 +9,49 @@ module Ide.Plugin.Tactic.LanguageServer where import Control.Arrow import Control.Monad import Control.Monad.Trans.Maybe -import Data.Aeson (Value(Object), fromJSON) -import Data.Aeson.Types (Result(Success, Error)) +import Data.Aeson (Value (Object), fromJSON) +import Data.Aeson.Types (Result (Error, Success)) import Data.Coerce -import Data.Functor ((<&>)) -import Data.Generics.Aliases (mkQ) -import Data.Generics.Schemes (everything) -import Data.Map (Map) -import qualified Data.Map as M +import Data.Functor ((<&>)) +import Data.Generics.Aliases (mkQ) +import Data.Generics.Schemes (everything) +import Data.Map (Map) +import qualified Data.Map as M import Data.Maybe import Data.Monoid -import qualified Data.Set as S -import qualified Data.Text as T +import qualified Data.Set as S +import qualified Data.Text as T import Data.Traversable +import Development.IDE (ShakeExtras, + getPluginConfig) import Development.IDE.Core.PositionMapping import Development.IDE.Core.RuleTypes -import Development.IDE.Core.Service (runAction) -import Development.IDE.Core.Shake (useWithStale, IdeState (..)) +import Development.IDE.Core.Service (runAction) +import Development.IDE.Core.Shake (IdeState (..), + useWithStale) import Development.IDE.GHC.Compat -import Development.IDE.GHC.Error (realSrcSpanToRange) -import Development.IDE.Spans.LocalBindings (Bindings, getDefiningBindings) -import Development.Shake (RuleResult, Action) +import Development.IDE.GHC.Error (realSrcSpanToRange) +import Development.IDE.Spans.LocalBindings (Bindings, + getDefiningBindings) +import Development.Shake (Action, RuleResult) import Development.Shake.Classes import qualified FastString -import Ide.Plugin.Config (PluginConfig(plcConfig)) -import qualified Ide.Plugin.Config as Plugin +import Ide.Plugin.Config (PluginConfig (plcConfig)) +import qualified Ide.Plugin.Config as Plugin import Ide.Plugin.Tactic.Context import Ide.Plugin.Tactic.FeatureSet import Ide.Plugin.Tactic.GHC import Ide.Plugin.Tactic.Judgements import Ide.Plugin.Tactic.Range -import Ide.Plugin.Tactic.TestTypes (cfg_feature_set, TacticCommand) +import Ide.Plugin.Tactic.TestTypes (TacticCommand, + cfg_feature_set) import Ide.Plugin.Tactic.Types -import Ide.PluginUtils (getPluginConfig) -import Language.LSP.Server (MonadLsp) +import Language.LSP.Server (MonadLsp) import Language.LSP.Types import OccName -import Prelude hiding (span) -import SrcLoc (containsSpan) -import TcRnTypes (tcg_binds) +import Prelude hiding (span) +import SrcLoc (containsSpan) +import TcRnTypes (tcg_binds) tacticDesc :: T.Text -> T.Text @@ -79,9 +83,9 @@ runStaleIde state nfp a = MaybeT $ runIde state $ useWithStale a nfp ------------------------------------------------------------------------------ -- | Get the current feature set from the plugin config. -getFeatureSet :: MonadLsp Plugin.Config m => m FeatureSet -getFeatureSet = do - pcfg <- getPluginConfig "tactics" +getFeatureSet :: MonadLsp Plugin.Config m => ShakeExtras -> m FeatureSet +getFeatureSet extras = do + pcfg <- getPluginConfig extras "tactics" pure $ case fromJSON $ Object $ plcConfig pcfg of Success cfg -> cfg_feature_set cfg Error _ -> defaultFeatures @@ -203,6 +207,6 @@ getRhsPosVals rss tcs isRhsHole :: RealSrcSpan -> TypecheckedSource -> Bool isRhsHole rss tcs = everything (||) (mkQ False $ \case TopLevelRHS _ _ (L (RealSrcSpan span) _) -> containsSpan rss span - _ -> False + _ -> False ) tcs