Skip to content

Commit aef649a

Browse files
pepeiborrapepeiborra
authored
Merge branch 'master' into hls-testing
2 parents ecb7ca0 + 099b4e7 commit aef649a

File tree

18 files changed

+127
-62
lines changed

18 files changed

+127
-62
lines changed

‎cabal.project

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -45,7 +45,7 @@ package *
4545

4646
write-ghc-environment-files: never
4747

48-
index-state: 2022-08-09T13:13:41Z
48+
index-state: 2022-08-15T06:53:13Z
4949

5050
constraints:
5151
hyphenation +embed,

‎exe/Plugins.hs

Lines changed: 0 additions & 4 deletions
Original file line numberDiff line numberDiff line change
@@ -211,12 +211,8 @@ idePlugins recorder includeExamples = pluginDescToIdePlugins allPlugins
211211
#if hls_gadt
212212
GADT.descriptor "gadt" :
213213
#endif
214-
-- The ghcide descriptors should come last so that the notification handlers
215-
-- (which restart the Shake build) run after everything else
216214
GhcIde.descriptors pluginRecorder
217215
#if explicitFixity
218-
-- Make this plugin has a lower priority than ghcide's plugin to ensure
219-
-- type info display first.
220216
++ [ExplicitFixity.descriptor pluginRecorder]
221217
#endif
222218
examplePlugins =

‎ghcide/ghcide.cabal

Lines changed: 2 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -108,7 +108,7 @@ library
108108
ghc-boot-th,
109109
ghc-boot,
110110
ghc >= 8.6,
111-
ghc-check >=0.5.0.4,
111+
ghc-check >=0.5.0.8,
112112
ghc-paths,
113113
cryptohash-sha1 >=0.11.100 && <0.12,
114114
hie-bios ^>= 0.9.1,
@@ -192,6 +192,7 @@ library
192192
Development.IDE.Monitoring.EKG
193193
Development.IDE.LSP.HoverDefinition
194194
Development.IDE.LSP.LanguageServer
195+
Development.IDE.LSP.Notifications
195196
Development.IDE.LSP.Outline
196197
Development.IDE.LSP.Server
197198
Development.IDE.Session
@@ -225,7 +226,6 @@ library
225226
Development.IDE.Core.FileExists
226227
Development.IDE.GHC.CPP
227228
Development.IDE.GHC.Warnings
228-
Development.IDE.LSP.Notifications
229229
Development.IDE.Plugin.CodeAction.PositionIndexed
230230
Development.IDE.Plugin.CodeAction.Args
231231
Development.IDE.Plugin.Completions.Logic

‎ghcide/src/Development/IDE/LSP/Notifications.hs

Lines changed: 10 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -10,6 +10,7 @@ module Development.IDE.LSP.Notifications
1010
( whenUriFile
1111
, descriptor
1212
, Log(..)
13+
, ghcideNotificationsPluginPriority
1314
) where
1415

1516
import Language.LSP.Types
@@ -38,6 +39,7 @@ import Development.IDE.Types.Location
3839
import Development.IDE.Types.Logger
3940
import Development.IDE.Types.Shake (toKey)
4041
import Ide.Types
42+
import Numeric.Natural
4143

4244
data Log
4345
= LogShake Shake.Log
@@ -138,5 +140,12 @@ descriptor recorder plId = (defaultPluginDescriptor plId) { pluginNotificationHa
138140
success <- registerFileWatches globs
139141
unless success $
140142
liftIO $ logDebug (ideLogger ide) "Warning: Client does not support watched files. Falling back to OS polling"
141-
]
143+
],
144+
145+
-- The ghcide descriptors should come last'ish so that the notification handlers
146+
-- (which restart the Shake build) run after everything else
147+
pluginPriority = ghcideNotificationsPluginPriority
142148
}
149+
150+
ghcideNotificationsPluginPriority :: Natural
151+
ghcideNotificationsPluginPriority = defaultPluginPriority - 900

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

Lines changed: 13 additions & 9 deletions
Original file line numberDiff line numberDiff line change
@@ -21,6 +21,7 @@ import Control.Exception.Safe (SomeException,
2121
import Control.Monad.Extra (concatMapM, unless,
2222
when)
2323
import qualified Data.Aeson.Encode.Pretty as A
24+
import Data.Coerce (coerce)
2425
import Data.Default (Default (def))
2526
import Data.Foldable (traverse_)
2627
import Data.Hashable (hashed)
@@ -92,7 +93,8 @@ import Development.IDE.Types.Logger (Logger,
9293
Recorder,
9394
WithPriority,
9495
cmapWithPrio,
95-
logWith, vsep, (<+>))
96+
logWith, nest, vsep,
97+
(<+>))
9698
import Development.IDE.Types.Monitoring (Monitoring)
9799
import Development.IDE.Types.Options (IdeGhcSession,
98100
IdeOptions (optCheckParents, optCheckProject, optReportProgress, optRunSubset),
@@ -122,7 +124,7 @@ import Ide.Types (IdeCommand (IdeComman
122124
IdePlugins,
123125
PluginDescriptor (PluginDescriptor, pluginCli),
124126
PluginId (PluginId),
125-
ipMap)
127+
ipMap, pluginId)
126128
import qualified Language.LSP.Server as LSP
127129
import qualified "list-t" ListT
128130
import Numeric.Natural (Natural)
@@ -146,7 +148,7 @@ import Text.Printf (printf)
146148

147149
data Log
148150
= LogHeapStats !HeapStats.Log
149-
| LogLspStart
151+
| LogLspStart [PluginId]
150152
| LogLspStartDuration !Seconds
151153
| LogShouldRunSubset !Bool
152154
| LogOnlyPartialGhc92Support
@@ -163,10 +165,12 @@ data Log
163165
instance Pretty Log where
164166
pretty = \case
165167
LogHeapStats log -> pretty log
166-
LogLspStart ->
167-
vsep
168-
[ "Staring LSP server..."
169-
, "If you are seeing this in a terminal, you probably should have run WITHOUT the --lsp option!"]
168+
LogLspStart pluginIds ->
169+
nest 2 $ vsep
170+
[ "Starting LSP server..."
171+
, "If you are seeing this in a terminal, you probably should have run WITHOUT the --lsp option!"
172+
, "PluginIds:" <+> pretty (coerce @_ @[T.Text] pluginIds)
173+
]
170174
LogLspStartDuration duration ->
171175
"Started LSP server in" <+> pretty (showDuration duration)
172176
LogShouldRunSubset shouldRunSubset ->
@@ -224,7 +228,7 @@ commandP plugins =
224228

225229
pluginCommands = mconcat
226230
[ command (T.unpack pId) (Custom <$> p)
227-
| (PluginId pId, PluginDescriptor{pluginCli = Just p}) <- ipMap plugins
231+
| PluginDescriptor{pluginCli = Just p, pluginId = PluginId pId} <- ipMap plugins
228232
]
229233

230234

@@ -336,7 +340,7 @@ defaultMain recorder Arguments{..} = withHeapStats (cmapWithPrio LogHeapStats re
336340
LT.putStrLn $ decodeUtf8 $ A.encodePretty $ pluginsToDefaultConfig argsHlsPlugins
337341
LSP -> withNumCapabilities (maybe (numProcessors `div` 2) fromIntegral argsThreads) $ do
338342
t <- offsetTime
339-
log Info LogLspStart
343+
log Info $ LogLspStart (pluginId <$> ipMap argsHlsPlugins)
340344

341345
let getIdeState :: LSP.LanguageContextEnv Config -> Maybe FilePath -> WithHieDb -> IndexQueue -> IO IdeState
342346
getIdeState env rootPath withHieDb hieChan = do

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

Lines changed: 6 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -5,6 +5,7 @@
55
module Development.IDE.Plugin.Completions
66
( descriptor
77
, Log(..)
8+
, ghcideCompletionsPluginPriority
89
) where
910

1011
import Control.Concurrent.Async (concurrently)
@@ -49,6 +50,7 @@ import Ide.Types
4950
import qualified Language.LSP.Server as LSP
5051
import Language.LSP.Types
5152
import qualified Language.LSP.VFS as VFS
53+
import Numeric.Natural
5254
import Text.Fuzzy.Parallel (Scored (..))
5355

5456
data Log = LogShake Shake.Log deriving Show
@@ -57,12 +59,16 @@ instance Pretty Log where
5759
pretty = \case
5860
LogShake log -> pretty log
5961

62+
ghcideCompletionsPluginPriority :: Natural
63+
ghcideCompletionsPluginPriority = defaultPluginPriority
64+
6065
descriptor :: Recorder (WithPriority Log) -> PluginId -> PluginDescriptor IdeState
6166
descriptor recorder plId = (defaultPluginDescriptor plId)
6267
{ pluginRules = produceCompletions recorder
6368
, pluginHandlers = mkPluginHandler STextDocumentCompletion getCompletionsLSP
6469
, pluginCommands = [extendImportCommand]
6570
, pluginConfigDescriptor = defaultConfigDescriptor {configCustomConfig = mkCustomConfig properties}
71+
, pluginPriority = ghcideCompletionsPluginPriority
6672
}
6773

6874
produceCompletions :: Recorder (WithPriority Log) -> Rules ()

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

Lines changed: 1 addition & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -13,7 +13,6 @@ import Control.Exception (SomeException)
1313
import Control.Lens ((^.))
1414
import Control.Monad
1515
import qualified Data.Aeson as J
16-
import Data.Bifunctor
1716
import Data.Dependent.Map (DMap)
1817
import qualified Data.Dependent.Map as DMap
1918
import Data.Dependent.Sum
@@ -96,7 +95,7 @@ asGhcIdePlugin recorder (IdePlugins ls) =
9695

9796
mkPlugin :: ([(PluginId, b)] -> Plugin Config) -> (PluginDescriptor IdeState -> b) -> Plugin Config
9897
mkPlugin maker selector =
99-
case map (second selector) ls of
98+
case map (\p -> (pluginId p, selector p)) ls of
10099
-- If there are no plugins that provide a descriptor, use mempty to
101100
-- create the plugin – otherwise we we end up declaring handlers for
102101
-- capabilities that there are no plugins for

‎ghcide/test/exe/Main.hs

Lines changed: 9 additions & 6 deletions
Original file line numberDiff line numberDiff line change
@@ -290,7 +290,8 @@ initializeResponseTests = withResource acquire release tests where
290290
doTest = do
291291
ir <- getInitializeResponse
292292
let Just ExecuteCommandOptions {_commands = List commands} = getActual $ innerCaps ir
293-
zipWithM_ (\e o -> T.isSuffixOf e o @? show (e,o)) expected commands
293+
commandNames = (!! 2) . T.splitOn ":" <$> commands
294+
zipWithM_ (\e o -> T.isSuffixOf e o @? show (e,o)) (sort expected) (sort commandNames)
294295

295296
innerCaps :: ResponseMessage Initialize -> ServerCapabilities
296297
innerCaps (ResponseMessage _ _ (Right (InitializeResult c _))) = c
@@ -6750,24 +6751,26 @@ unitTests recorder logger = do
67506751
let expected = "1:2-3:4"
67516752
assertBool (unwords ["expected to find range", expected, "in diagnostic", shown]) $
67526753
expected `isInfixOf` shown
6753-
, testCase "notification handlers run sequentially" $ do
6754+
, testCase "notification handlers run in priority order" $ do
67546755
orderRef <- newIORef []
67556756
let plugins = pluginDescToIdePlugins $
6756-
[ (defaultPluginDescriptor $ fromString $ show i)
6757+
[ (priorityPluginDescriptor i)
67576758
{ pluginNotificationHandlers = mconcat
67586759
[ mkPluginNotificationHandler LSP.STextDocumentDidOpen $ \_ _ _ _ ->
67596760
liftIO $ atomicModifyIORef_ orderRef (i:)
67606761
]
67616762
}
6762-
| i <- [(1::Int)..20]
6763+
| i <- [1..20]
67636764
] ++ Ghcide.descriptors (cmapWithPrio LogGhcIde recorder)
6765+
priorityPluginDescriptor i = (defaultPluginDescriptor $ fromString $ show i){pluginPriority = i}
67646766

67656767
testIde recorder (IDE.testing (cmapWithPrio LogIDEMain recorder) logger){IDE.argsHlsPlugins = plugins} $ do
67666768
_ <- createDoc "A.hs" "haskell" "module A where"
67676769
waitForProgressDone
6768-
actualOrder <- liftIO $ readIORef orderRef
6770+
actualOrder <- liftIO $ reverse <$> readIORef orderRef
67696771

6770-
liftIO $ actualOrder @?= reverse [(1::Int)..20]
6772+
-- Handlers are run in priority descending order
6773+
liftIO $ actualOrder @?= [20, 19 .. 1]
67716774
, ignoreTestBecause "The test fails sometimes showing 10000us" $
67726775
testCase "timestamps have millisecond resolution" $ do
67736776
resolution_us <- findResolution_us 1

‎hls-plugin-api/src/Ide/Plugin/ConfigUtils.hs

Lines changed: 2 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -34,7 +34,7 @@ pluginsToDefaultConfig IdePlugins {..} =
3434
A.toJSON defaultConfig & ix "haskell" . _Object . at "plugin" ?~ elems
3535
where
3636
defaultConfig@Config {} = def
37-
elems = A.object $ mconcat $ singlePlugin <$> map snd ipMap
37+
elems = A.object $ mconcat $ singlePlugin <$> ipMap
3838
-- Splice genericDefaultConfig and dedicatedDefaultConfig
3939
-- Example:
4040
--
@@ -96,7 +96,7 @@ pluginsToDefaultConfig IdePlugins {..} =
9696
-- | Generates json schema used in haskell vscode extension
9797
-- Similar to 'pluginsToDefaultConfig' but simpler, since schema has a flatten structure
9898
pluginsToVSCodeExtensionSchema :: IdePlugins a -> A.Value
99-
pluginsToVSCodeExtensionSchema IdePlugins {..} = A.object $ mconcat $ singlePlugin <$> map snd ipMap
99+
pluginsToVSCodeExtensionSchema IdePlugins {..} = A.object $ mconcat $ singlePlugin <$> ipMap
100100
where
101101
singlePlugin PluginDescriptor {pluginConfigDescriptor = ConfigDescriptor {..}, ..} = genericSchema <> dedicatedSchema
102102
where

‎hls-plugin-api/src/Ide/PluginUtils.hs

Lines changed: 5 additions & 13 deletions
Original file line numberDiff line numberDiff line change
@@ -36,13 +36,13 @@ module Ide.PluginUtils
3636
where
3737

3838

39+
import Control.Arrow ((&&&))
3940
import Control.Monad.Extra (maybeM)
4041
import Control.Monad.Trans.Class (lift)
4142
import Control.Monad.Trans.Except (ExceptT, runExceptT, throwE)
4243
import Data.Algorithm.Diff
4344
import Data.Algorithm.DiffOutput
4445
import Data.Bifunctor (Bifunctor (first))
45-
import Data.Containers.ListUtils (nubOrdOn)
4646
import qualified Data.HashMap.Strict as H
4747
import Data.String (IsString (fromString))
4848
import qualified Data.Text as T
@@ -159,11 +159,10 @@ clientSupportsDocumentChanges caps =
159159
-- ---------------------------------------------------------------------
160160

161161
pluginDescToIdePlugins :: [PluginDescriptor ideState] -> IdePlugins ideState
162-
pluginDescToIdePlugins plugins =
163-
IdePlugins $ map (\p -> (pluginId p, p)) $ nubOrdOn pluginId plugins
162+
pluginDescToIdePlugins = IdePlugins
164163

165164
idePluginsToPluginDesc :: IdePlugins ideState -> [PluginDescriptor ideState]
166-
idePluginsToPluginDesc (IdePlugins pp) = map snd pp
165+
idePluginsToPluginDesc (IdePlugins pp) = pp
167166

168167
-- ---------------------------------------------------------------------
169168
-- | Returns the current client configuration. It is not wise to permanently
@@ -226,15 +225,8 @@ positionInRange p (Range sp ep) = sp <= p && p < ep -- Range's end position is e
226225
-- ---------------------------------------------------------------------
227226

228227
allLspCmdIds' :: T.Text -> IdePlugins ideState -> [T.Text]
229-
allLspCmdIds' pid (IdePlugins ls) = mkPlugin (allLspCmdIds pid) (Just . pluginCommands)
230-
where
231-
justs (p, Just x) = [(p, x)]
232-
justs (_, Nothing) = []
233-
234-
235-
mkPlugin maker selector
236-
= maker $ concatMap (\(pid, p) -> justs (pid, selector p)) ls
237-
228+
allLspCmdIds' pid (IdePlugins ls) =
229+
allLspCmdIds pid $ map (pluginId &&& pluginCommands) ls
238230

239231
allLspCmdIds :: T.Text -> [(PluginId, [PluginCommand ideState])] -> [T.Text]
240232
allLspCmdIds pid commands = concatMap go commands

0 commit comments

Comments
 (0)