Skip to content

Commit 02f18ae

Browse files
pepeiborrapepeiborra
authored
Fix the handling of default HLS config again (#1419)
1 parent 8946578 commit 02f18ae

File tree

9 files changed

+204
-180
lines changed

9 files changed

+204
-180
lines changed

‎ghcide/src/Development/IDE.hs

+42-38
Original file line numberDiff line numberDiff line change
@@ -6,41 +6,45 @@ module Development.IDE
66

77
) where
88

9-
import Development.IDE.Core.RuleTypes as X
10-
import Development.IDE.Core.Rules as X
11-
(getAtPoint
12-
,getClientConfigAction
13-
,getDefinition
14-
,getParsedModule
15-
,getTypeDefinition
16-
)
17-
import Development.IDE.Core.FileExists as X
18-
(getFileExists)
19-
import Development.IDE.Core.FileStore as X
20-
(getFileContents)
21-
import Development.IDE.Core.IdeConfiguration as X
22-
(IdeConfiguration(..)
23-
,isWorkspaceFile)
24-
import Development.IDE.Core.OfInterest as X (getFilesOfInterest)
25-
import Development.IDE.Core.Service as X (runAction)
26-
import Development.IDE.Core.Shake as X
27-
( IdeState,
28-
shakeExtras,
29-
ShakeExtras,
30-
IdeRule,
31-
define, defineEarlyCutoff,
32-
use, useNoFile, uses, useWithStale, useWithStaleFast, useWithStaleFast',
33-
FastResult(..),
34-
use_, useNoFile_, uses_, useWithStale_,
35-
ideLogger,
36-
actionLogger,
37-
IdeAction(..), runIdeAction
38-
)
39-
import Development.IDE.GHC.Error as X
40-
import Development.IDE.GHC.Util as X
41-
import Development.IDE.Plugin as X
42-
import Development.IDE.Types.Diagnostics as X
43-
import Development.IDE.Types.HscEnvEq as X (HscEnvEq(..), hscEnv, hscEnvWithImportPaths)
44-
import Development.IDE.Types.Location as X
45-
import Development.IDE.Types.Logger as X
46-
import Development.Shake as X (Action, action, Rules, RuleResult)
9+
import Development.IDE.Core.FileExists as X (getFileExists)
10+
import Development.IDE.Core.FileStore as X (getFileContents)
11+
import Development.IDE.Core.IdeConfiguration as X (IdeConfiguration (..),
12+
isWorkspaceFile)
13+
import Development.IDE.Core.OfInterest as X (getFilesOfInterest)
14+
import Development.IDE.Core.RuleTypes as X
15+
import Development.IDE.Core.Rules as X (getAtPoint,
16+
getClientConfigAction,
17+
getDefinition,
18+
getParsedModule,
19+
getTypeDefinition)
20+
import Development.IDE.Core.Service as X (runAction)
21+
import Development.IDE.Core.Shake as X (FastResult (..),
22+
IdeAction (..),
23+
IdeRule, IdeState,
24+
ShakeExtras,
25+
actionLogger,
26+
define,
27+
defineEarlyCutoff,
28+
getClientConfig,
29+
getPluginConfig,
30+
ideLogger,
31+
runIdeAction,
32+
shakeExtras, use,
33+
useNoFile,
34+
useNoFile_,
35+
useWithStale,
36+
useWithStaleFast,
37+
useWithStaleFast',
38+
useWithStale_,
39+
use_, uses, uses_)
40+
import Development.IDE.GHC.Error as X
41+
import Development.IDE.GHC.Util as X
42+
import Development.IDE.Plugin as X
43+
import Development.IDE.Types.Diagnostics as X
44+
import Development.IDE.Types.HscEnvEq as X (HscEnvEq (..),
45+
hscEnv,
46+
hscEnvWithImportPaths)
47+
import Development.IDE.Types.Location as X
48+
import Development.IDE.Types.Logger as X
49+
import Development.Shake as X (Action, RuleResult,
50+
Rules, action)

‎ghcide/src/Development/IDE/Core/Service.hs

+13-11
Original file line numberDiff line numberDiff line change
@@ -1,9 +1,9 @@
11
-- Copyright (c) 2019 The DAML Authors. All rights reserved.
22
-- SPDX-License-Identifier: Apache-2.0
33

4-
{-# LANGUAGE TypeFamilies #-}
54
{-# LANGUAGE FlexibleInstances #-}
6-
{-# LANGUAGE RankNTypes #-}
5+
{-# LANGUAGE RankNTypes #-}
6+
{-# LANGUAGE TypeFamilies #-}
77

88
-- | A Shake implementation of the compiler service, built
99
-- using the "Shaker" abstraction layer for in-memory use.
@@ -18,26 +18,27 @@ module Development.IDE.Core.Service(
1818
updatePositionMapping,
1919
) where
2020

21-
import Development.IDE.Types.Options (IdeOptions(..))
22-
import Development.IDE.Core.Debouncer
23-
import Development.IDE.Core.FileStore (fileStoreRules)
21+
import Development.IDE.Core.Debouncer
2422
import Development.IDE.Core.FileExists (fileExistsRules)
23+
import Development.IDE.Core.FileStore (fileStoreRules)
2524
import Development.IDE.Core.OfInterest
26-
import Development.IDE.Types.Logger as Logger
25+
import Development.IDE.Types.Logger as Logger
26+
import Development.IDE.Types.Options (IdeOptions (..))
2727
import Development.Shake
28-
import qualified Language.LSP.Server as LSP
29-
import qualified Language.LSP.Types as LSP
3028
import Ide.Plugin.Config
29+
import qualified Language.LSP.Server as LSP
30+
import qualified Language.LSP.Types as LSP
3131

32+
import Control.Monad
3233
import Development.IDE.Core.Shake
33-
import Control.Monad
3434

3535

3636
------------------------------------------------------------
3737
-- Exposed API
3838

3939
-- | Initialise the Compiler Service.
40-
initialise :: Rules ()
40+
initialise :: Config
41+
-> Rules ()
4142
-> Maybe (LSP.LanguageContextEnv Config)
4243
-> Logger
4344
-> Debouncer LSP.NormalizedUri
@@ -46,9 +47,10 @@ initialise :: Rules ()
4647
-> HieDb
4748
-> IndexQueue
4849
-> IO IdeState
49-
initialise mainRule lspEnv logger debouncer options vfs hiedb hiedbChan =
50+
initialise defaultConfig mainRule lspEnv logger debouncer options vfs hiedb hiedbChan =
5051
shakeOpen
5152
lspEnv
53+
defaultConfig
5254
logger
5355
debouncer
5456
(optShakeProfiling options)

‎ghcide/src/Development/IDE/Core/Shake.hs

+18-1
Original file line numberDiff line numberDiff line change
@@ -47,6 +47,8 @@ module Development.IDE.Core.Shake(
4747
getIdeOptions,
4848
getIdeOptionsIO,
4949
GlobalIdeOptions(..),
50+
getClientConfig,
51+
getPluginConfig,
5052
garbageCollect,
5153
knownTargets,
5254
setPriority,
@@ -140,6 +142,8 @@ import Control.Exception.Extra hiding (bracket_)
140142
import UnliftIO.Exception (bracket_)
141143
import Ide.Plugin.Config
142144
import Data.Default
145+
import qualified Ide.PluginUtils as HLS
146+
import Ide.Types ( PluginId )
143147

144148
-- | We need to serialize writes to the database, so we send any function that
145149
-- needs to write to the database over the channel, where it will be picked up by
@@ -196,6 +200,8 @@ data ShakeExtras = ShakeExtras
196200
-- ^ Registery for functions that compute/get "stale" results for the rule
197201
-- (possibly from disk)
198202
, vfs :: VFSHandle
203+
, defaultConfig :: Config
204+
-- ^ Default HLS config, only relevant if the client does not provide any Config
199205
}
200206

201207
type WithProgressFunc = forall a.
@@ -219,6 +225,16 @@ getShakeExtrasRules = do
219225
Just x <- getShakeExtraRules @ShakeExtras
220226
return x
221227

228+
getClientConfig :: LSP.MonadLsp Config m => ShakeExtras -> m Config
229+
getClientConfig ShakeExtras { defaultConfig } =
230+
fromMaybe defaultConfig <$> HLS.getClientConfig
231+
232+
getPluginConfig
233+
:: LSP.MonadLsp Config m => ShakeExtras -> PluginId -> m PluginConfig
234+
getPluginConfig extras plugin = do
235+
config <- getClientConfig extras
236+
return $ HLS.configForPlugin config plugin
237+
222238
-- | Register a function that will be called to get the "stale" result of a rule, possibly from disk
223239
-- This is called when we don't already have a result, or computing the rule failed.
224240
-- 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
445461

446462
-- | Open a 'IdeState', should be shut using 'shakeShut'.
447463
shakeOpen :: Maybe (LSP.LanguageContextEnv Config)
464+
-> Config
448465
-> Logger
449466
-> Debouncer NormalizedUri
450467
-> Maybe FilePath
@@ -456,7 +473,7 @@ shakeOpen :: Maybe (LSP.LanguageContextEnv Config)
456473
-> ShakeOptions
457474
-> Rules ()
458475
-> IO IdeState
459-
shakeOpen lspEnv logger debouncer
476+
shakeOpen lspEnv defaultConfig logger debouncer
460477
shakeProfileDir (IdeReportProgress reportProgress) ideTesting@(IdeTesting testing) hiedb indexQueue vfs opts rules = mdo
461478

462479
inProgress <- newVar HMap.empty

‎ghcide/src/Development/IDE/Main.hs

+3-2
Original file line numberDiff line numberDiff line change
@@ -104,7 +104,7 @@ defaultMain :: Arguments -> IO ()
104104
defaultMain Arguments{..} = do
105105
pid <- T.pack . show <$> getProcessID
106106

107-
let hlsPlugin = asGhcIdePlugin argsHlsPlugins
107+
let hlsPlugin = asGhcIdePlugin argsDefaultHlsConfig argsHlsPlugins
108108
hlsCommands = allLspCmdIds' pid argsHlsPlugins
109109
plugins = hlsPlugin <> argsGhcidePlugin
110110
options = argsLspOptions { LSP.executeCommandCommands = Just hlsCommands }
@@ -138,6 +138,7 @@ defaultMain Arguments{..} = do
138138
caps = LSP.resClientCapabilities env
139139
debouncer <- newAsyncDebouncer
140140
initialise
141+
argsDefaultHlsConfig
141142
rules
142143
(Just env)
143144
argsLogger
@@ -177,7 +178,7 @@ defaultMain Arguments{..} = do
177178
{ optCheckParents = pure NeverCheck
178179
, optCheckProject = pure False
179180
}
180-
ide <- initialise rules Nothing argsLogger debouncer options vfs hiedb hieChan
181+
ide <- initialise argsDefaultHlsConfig rules Nothing argsLogger debouncer options vfs hiedb hieChan
181182

182183
putStrLn "\nStep 4/4: Type checking the files"
183184
setFilesOfInterest ide $ HashMap.fromList $ map ((,OnDisk) . toNormalizedFilePath') files

‎ghcide/src/Development/IDE/Plugin/Completions.hs

+35-35
Original file line numberDiff line numberDiff line change
@@ -9,38 +9,38 @@ module Development.IDE.Plugin.Completions
99
, NonLocalCompletions(..)
1010
) where
1111

12-
import Control.Monad
13-
import Control.Monad.Extra
14-
import Control.Monad.Trans.Maybe
15-
import Data.Aeson
16-
import Data.List (find)
17-
import Data.Maybe
18-
import qualified Data.Text as T
19-
import Language.LSP.Types
20-
import qualified Language.LSP.Server as LSP
21-
import qualified Language.LSP.VFS as VFS
22-
import Development.Shake.Classes
23-
import Development.Shake
24-
import GHC.Generics
25-
import Development.IDE.Core.Service
26-
import Development.IDE.Core.PositionMapping
27-
import Development.IDE.Plugin.Completions.Logic
28-
import Development.IDE.Types.Location
29-
import Development.IDE.Core.RuleTypes
30-
import Development.IDE.Core.Shake
31-
import Development.IDE.GHC.Compat
32-
import Development.IDE.GHC.ExactPrint (Annotated (annsA), GetAnnotatedParsedSource (GetAnnotatedParsedSource))
33-
import Development.IDE.Types.HscEnvEq (hscEnv)
34-
import Development.IDE.Plugin.CodeAction.ExactPrint
35-
import Development.IDE.Plugin.Completions.Types
36-
import Ide.Plugin.Config (Config (completionSnippetsOn))
37-
import Ide.PluginUtils (getClientConfig)
38-
import Ide.Types
39-
import TcRnDriver (tcRnImportDecls)
40-
import Control.Concurrent.Async (concurrently)
41-
import GHC.Exts (toList)
42-
import Development.IDE.GHC.Error (rangeToSrcSpan)
43-
import Development.IDE.GHC.Util (prettyPrint)
12+
import Control.Concurrent.Async (concurrently)
13+
import Control.Monad
14+
import Control.Monad.Extra
15+
import Control.Monad.Trans.Maybe
16+
import Data.Aeson
17+
import Data.List (find)
18+
import Data.Maybe
19+
import qualified Data.Text as T
20+
import Development.IDE.Core.PositionMapping
21+
import Development.IDE.Core.RuleTypes
22+
import Development.IDE.Core.Service
23+
import Development.IDE.Core.Shake
24+
import Development.IDE.GHC.Compat
25+
import Development.IDE.GHC.Error (rangeToSrcSpan)
26+
import Development.IDE.GHC.ExactPrint (Annotated (annsA),
27+
GetAnnotatedParsedSource (GetAnnotatedParsedSource))
28+
import Development.IDE.GHC.Util (prettyPrint)
29+
import Development.IDE.Plugin.CodeAction.ExactPrint
30+
import Development.IDE.Plugin.Completions.Logic
31+
import Development.IDE.Plugin.Completions.Types
32+
import Development.IDE.Types.HscEnvEq (hscEnv)
33+
import Development.IDE.Types.Location
34+
import Development.Shake
35+
import Development.Shake.Classes
36+
import GHC.Exts (toList)
37+
import GHC.Generics
38+
import Ide.Plugin.Config (Config (completionSnippetsOn))
39+
import Ide.Types
40+
import qualified Language.LSP.Server as LSP
41+
import Language.LSP.Types
42+
import qualified Language.LSP.VFS as VFS
43+
import TcRnDriver (tcRnImportDecls)
4444

4545
descriptor :: PluginId -> PluginDescriptor IdeState
4646
descriptor plId = (defaultPluginDescriptor plId)
@@ -86,7 +86,7 @@ dropListFromImportDecl iDecl = let
8686
f d@ImportDecl {ideclHiding} = case ideclHiding of
8787
Just (False, _) -> d {ideclHiding=Nothing}
8888
-- if hiding or Nothing just return d
89-
_ -> d
89+
_ -> d
9090
f x = x
9191
in f <$> iDecl
9292

@@ -135,7 +135,7 @@ getCompletionsLSP ide plId
135135
-> return (InL $ List [])
136136
(Just pfix', _) -> do
137137
let clientCaps = clientCapabilities $ shakeExtras ide
138-
config <- getClientConfig
138+
config <- getClientConfig $ shakeExtras ide
139139
let snippets = WithSnippets . completionSnippetsOn $ config
140140
allCompletions <- liftIO $ getCompletions plId ideOpts cci' parsedMod bindMap pfix' clientCaps snippets
141141
pure $ InL (List allCompletions)
@@ -200,5 +200,5 @@ liftMaybe :: Monad m => Maybe a -> MaybeT m a
200200
liftMaybe a = MaybeT $ pure a
201201

202202
liftEither :: Monad m => Either e a -> MaybeT m a
203-
liftEither (Left _) = mzero
203+
liftEither (Left _) = mzero
204204
liftEither (Right x) = return x

0 commit comments

Comments
 (0)