Skip to content

Commit c2bb264

Browse files
lukel97wz1000
lukel97
authored and
wz1000
committed
WIP integrate haskell-lsp-1.0.0.0
some progress Mostly everything except LanguageServer.hs make it compile make it work fix benchmarks update tweaks fix configuration and tests simplify handlers Update to renamed lsp/lsp-types modules redo plugin api and get library to compile fill in some missing details fix main fix rebase
1 parent c7cd09e commit c2bb264

Some content is hidden

Large Commits have some content hidden by default. Use the searchbox below for content that may be hidden.

47 files changed

+1033
-1497
lines changed

‎ghcide/bench/lib/Experiments.hs‎

Lines changed: 12 additions & 8 deletions
Original file line numberDiff line numberDiff line change
@@ -1,4 +1,5 @@
11
{-# LANGUAGE ConstraintKinds #-}
2+
{-# LANGUAGE GADTs #-}
23
{-# LANGUAGE ExistentialQuantification #-}
34
{-# LANGUAGE ImplicitParams #-}
45
{-# LANGUAGE ImpredicativeTypes #-}
@@ -23,16 +24,16 @@ import Control.Applicative.Combinators (skipManyTill)
2324
import Control.Exception.Safe
2425
import Control.Monad.Extra
2526
import Control.Monad.IO.Class
26-
import Data.Aeson (Value(Null))
27+
import Data.Aeson (Value(Null), toJSON)
2728
import Data.List
2829
import Data.Maybe
2930
import qualified Data.Text as T
3031
import Data.Version
3132
import Development.IDE.Plugin.Test
3233
import Experiments.Types
33-
import Language.Haskell.LSP.Test
34-
import Language.Haskell.LSP.Types
35-
import Language.Haskell.LSP.Types.Capabilities
34+
import Language.LSP.Test
35+
import Language.LSP.Types
36+
import Language.LSP.Types.Capabilities
3637
import Numeric.Natural
3738
import Options.Applicative
3839
import System.Directory
@@ -78,7 +79,7 @@ experiments =
7879
isJust <$> getHover doc (fromJust identifierP),
7980
---------------------------------------------------------------------------------------
8081
bench "getDefinition" 10 $ allWithIdentifierPos $ \DocumentPositions{..} ->
81-
not . null <$> getDefinitions doc (fromJust identifierP),
82+
either (not . null) (not . null) . toEither <$> getDefinitions doc (fromJust identifierP),
8283
---------------------------------------------------------------------------------------
8384
bench "getDefinition after edit" 10 $ \docs -> do
8485
forM_ docs $ \DocumentPositions{..} ->
@@ -330,7 +331,9 @@ waitForProgressDone :: Session ()
330331
waitForProgressDone = loop
331332
where
332333
loop = do
333-
void (skipManyTill anyMessage message :: Session WorkDoneProgressEndNotification)
334+
void $ skipManyTill anyMessage $ satisfyMaybe $ \case
335+
FromServerMess SProgress (NotificationMessage _ _ (ProgressParams _ (End _))) -> Just ()
336+
_ -> Nothing
334337
done <- null <$> getIncompleteProgressSessions
335338
unless done loop
336339

@@ -364,8 +367,9 @@ runBench runSess b = handleAny (\e -> print e >> return badRun)
364367
else do
365368
output (showDuration t)
366369
-- Wait for the delayed actions to finish
367-
waitId <- sendRequest (CustomClientMethod "test") WaitForShakeQueue
368-
(td, resp) <- duration $ skipManyTill anyMessage $ responseForId waitId
370+
let m = SCustomMethod "ghcide/blocking/queue"
371+
waitId <- sendRequest m (toJSON WaitForShakeQueue)
372+
(td, resp) <- duration $ skipManyTill anyMessage $ responseForId m waitId
369373
case resp of
370374
ResponseMessage{_result=Right Null} -> do
371375
loop (userWaits+t) (delayedWork+td) (n -1)

‎ghcide/exe/Main.hs‎

Lines changed: 16 additions & 20 deletions
Original file line numberDiff line numberDiff line change
@@ -32,10 +32,9 @@ import Development.IDE.Plugin
3232
import Development.IDE.Plugin.Test as Test
3333
import Development.IDE.Session (loadSession, setInitialDynFlags, getHieDbLoc, runWithDb)
3434
import Development.Shake (ShakeOptions (shakeThreads))
35-
import qualified Language.Haskell.LSP.Core as LSP
36-
import Language.Haskell.LSP.Messages
37-
import Language.Haskell.LSP.Types
38-
import Language.Haskell.LSP.Types.Lens (params, initializationOptions)
35+
import qualified Language.LSP.Server as LSP
36+
import Language.LSP.Types
37+
import Language.LSP.Types.Lens (params, initializationOptions)
3938
import Development.IDE.LSP.LanguageServer
4039
import qualified System.Directory.Extra as IO
4140
import System.Environment
@@ -117,22 +116,19 @@ runIde Arguments{..} hiedb hiechan = do
117116

118117
let plugins = hlsPlugin
119118
<> if argsTesting then Test.plugin else mempty
120-
onInitialConfiguration :: InitializeRequest -> Either T.Text Config
121-
onInitialConfiguration x = case x ^. params . initializationOptions of
122-
Nothing -> Right def
123-
Just v -> case J.fromJSON v of
124-
J.Error err -> Left $ T.pack err
125-
J.Success a -> Right a
126-
onConfigurationChange = const $ Left "Updating Not supported"
127119
options = def { LSP.executeCommandCommands = Just hlsCommands
128120
, LSP.completionTriggerCharacters = Just "."
129121
}
122+
onConfigurationChange _ide v = pure $ case J.fromJSON v of
123+
J.Error err -> Left $ T.pack err
124+
J.Success a -> Right a
125+
130126
case argFilesOrCmd of
131127
Nothing -> do
132128
t <- offsetTime
133129
hPutStrLn stderr "Starting LSP server..."
134130
hPutStrLn stderr "If you are seeing this in a terminal, you probably should have run ghcide WITHOUT the --lsp option!"
135-
runLanguageServer options (pluginHandler plugins) onInitialConfiguration onConfigurationChange $ \getLspId event vfs caps wProg wIndefProg getConfig rootPath -> do
131+
runLanguageServer options onConfigurationChange (pluginHandlers plugins) $ \env vfs rootPath -> do
136132
t <- t
137133
hPutStrLn stderr $ "Started LSP server in " ++ showDuration t
138134

@@ -144,15 +140,16 @@ runIde Arguments{..} hiedb hiechan = do
144140
`catchAny` (\e -> (hPutStrLn stderr $ "setInitialDynFlags: " ++ displayException e) >> pure Nothing)
145141

146142
sessionLoader <- loadSession $ fromMaybe dir rootPath
147-
config <- fromMaybe def <$> getConfig
143+
let config = maybe def id <$> (LSP.runLspT env LSP.getConfig)
144+
caps <- LSP.runLspT env LSP.getClientCapabilities
148145
let options = defOptions
149146
{ optReportProgress = clientSupportsProgress caps
150147
, optShakeProfiling = argsShakeProfiling
151148
, optOTMemoryProfiling = IdeOTMemoryProfiling argsOTMemoryProfiling
152149
, optTesting = IdeTesting argsTesting
153150
, optShakeOptions = (optShakeOptions defOptions){shakeThreads = argsThreads}
154-
, optCheckParents = checkParents config
155-
, optCheckProject = checkProject config
151+
, optCheckParents = checkParents <$> config
152+
, optCheckProject = checkProject <$> config
156153
}
157154
defOptions = defaultIdeOptions sessionLoader
158155
logLevel = if argsVerbose then minBound else Info
@@ -165,8 +162,7 @@ runIde Arguments{..} hiedb hiechan = do
165162
-- Shake database restart, i.e. on every user edit.
166163
unless argsDisableKick $
167164
action kick
168-
initialise caps rules
169-
getLspId event wProg wIndefProg (logger logLevel) debouncer options vfs hiedb hiechan
165+
initialise rules (Just env) (logger logLevel) debouncer options vfs hiedb hiechan
170166
Just argFiles -> do
171167
-- GHC produces messages with UTF8 in them, so make sure the terminal doesn't error
172168
hSetEncoding stdout utf8
@@ -197,12 +193,12 @@ runIde Arguments{..} hiedb hiechan = do
197193
-- , optOTMemoryProfiling = IdeOTMemoryProfiling argsOTMemoryProfiling
198194
, optTesting = IdeTesting argsTesting
199195
, optShakeOptions = (optShakeOptions defOptions){shakeThreads = argsThreads}
200-
, optCheckParents = NeverCheck
201-
, optCheckProject = False
196+
, optCheckParents = pure NeverCheck
197+
, optCheckProject = pure False
202198
}
203199
defOptions = defaultIdeOptions sessionLoader
204200
logLevel = if argsVerbose then minBound else Info
205-
ide <- initialise def mainRule (pure $ IdInt 0) (showEvent lock) dummyWithProg (const (const id)) (logger logLevel) debouncer options vfs hiedb hiechan
201+
ide <- initialise mainRule Nothing (logger logLevel) debouncer (defaultIdeOptions sessionLoader) vfs hiedb hiechan
206202

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

‎ghcide/ghcide.cabal‎

Lines changed: 12 additions & 9 deletions
Original file line numberDiff line numberDiff line change
@@ -46,6 +46,8 @@ library
4646
data-default,
4747
deepseq,
4848
directory,
49+
dependent-map,
50+
dependent-sum,
4951
dlist,
5052
extra >= 1.7.4,
5153
fuzzy,
@@ -55,12 +57,12 @@ library
5557
Glob,
5658
haddock-library >= 1.8,
5759
hashable,
58-
haskell-lsp-types == 0.23.*,
59-
haskell-lsp == 0.23.*,
6060
hie-compat,
6161
hls-plugin-api >= 0.6,
6262
lens,
6363
hiedb == 0.3.0.1,
64+
lsp-types == 1.0.*,
65+
lsp == 1.0.*,
6466
mtl,
6567
network-uri,
6668
parallel,
@@ -88,7 +90,8 @@ library
8890
vector,
8991
bytestring-encoding,
9092
opentelemetry >=0.6.1,
91-
heapsize ==0.3.*
93+
heapsize ==0.3.*,
94+
unliftio
9295
if flag(ghc-lib)
9396
build-depends:
9497
ghc-lib >= 8.8,
@@ -282,8 +285,8 @@ executable ghcide
282285
safe-exceptions,
283286
ghc,
284287
hashable,
285-
haskell-lsp,
286-
haskell-lsp-types,
288+
lsp,
289+
lsp-types,
287290
heapsize,
288291
hie-bios,
289292
hls-plugin-api,
@@ -342,12 +345,12 @@ test-suite ghcide-tests
342345
ghcide,
343346
ghc-typelits-knownnat,
344347
haddock-library,
345-
haskell-lsp,
346-
haskell-lsp-types,
348+
lsp,
349+
lsp-types,
347350
hls-plugin-api,
348351
network-uri,
349352
lens,
350-
lsp-test >= 0.12.0.0 && < 0.13,
353+
lsp-test >= 0.11.0.6 && < 0.13,
351354
optparse-applicative,
352355
process,
353356
QuickCheck,
@@ -404,7 +407,7 @@ executable ghcide-bench
404407
extra,
405408
filepath,
406409
ghcide,
407-
lsp-test >= 0.12.0.0 && < 0.13,
410+
lsp-test >= 0.11.0.6 && < 0.13,
408411
optparse-applicative,
409412
process,
410413
safe-exceptions,

‎ghcide/session-loader/Development/IDE/Session.hs‎

Lines changed: 17 additions & 28 deletions
Original file line numberDiff line numberDiff line change
@@ -58,9 +58,8 @@ import qualified HIE.Bios as HieBios
5858
import HIE.Bios.Environment hiding (getCacheDir)
5959
import HIE.Bios.Types
6060
import Hie.Implicit.Cradle (loadImplicitHieCradle)
61-
import Language.Haskell.LSP.Core
62-
import Language.Haskell.LSP.Messages
63-
import Language.Haskell.LSP.Types
61+
import Language.LSP.Server
62+
import Language.LSP.Types
6463
import System.Directory
6564
import qualified System.Directory.Extra as IO
6665
import System.FilePath
@@ -206,12 +205,11 @@ loadSessionWithOptions SessionLoadingOptions{..} dir = do
206205
runningCradle <- newVar dummyAs :: IO (Var (Async (IdeResult HscEnvEq,[FilePath])))
207206

208207
return $ do
209-
extras@ShakeExtras{logger, eventer, restartShakeSession,
210-
withIndefiniteProgress, ideNc, knownTargetsVar
208+
extras@ShakeExtras{logger, restartShakeSession, ideNc, knownTargetsVar, lspEnv
211209
} <- getShakeExtras
212210

213211
IdeOptions{ optTesting = IdeTesting optTesting
214-
, optCheckProject = checkProject
212+
, optCheckProject = getCheckProject
215213
, optCustomDynFlags
216214
, optExtensions
217215
} <- getIdeOptions
@@ -356,6 +354,7 @@ loadSessionWithOptions SessionLoadingOptions{..} dir = do
356354
restartShakeSession []
357355

358356
-- Typecheck all files in the project on startup
357+
checkProject <- getCheckProject
359358
unless (null cs || not checkProject) $ do
360359
cfps' <- liftIO $ filterM (IO.doesFileExist . fromNormalizedFilePath) (concatMap targetLocations cs)
361360
void $ shakeEnqueue extras $ mkDelayedAction "InitialLoad" Debug $ void $ do
@@ -374,17 +373,19 @@ loadSessionWithOptions SessionLoadingOptions{..} dir = do
374373
lfp <- flip makeRelative cfp <$> getCurrentDirectory
375374
logInfo logger $ T.pack ("Consulting the cradle for " <> show lfp)
376375

377-
when (isNothing hieYaml) $ eventer $ notifyUserImplicitCradle lfp
376+
when (isNothing hieYaml) $ mRunLspT lspEnv $
377+
sendNotification SWindowShowMessage $ notifyUserImplicitCradle lfp
378378

379379
cradle <- maybe (loadImplicitHieCradle $ addTrailingPathSeparator dir) loadCradle hieYaml
380380

381-
when optTesting $ eventer $ notifyCradleLoaded lfp
381+
when optTesting $ mRunLspT lspEnv $
382+
sendNotification (SCustomMethod "ghcide/cradle/loaded") (toJSON cfp)
382383

383384
-- Display a user friendly progress message here: They probably don't know what a cradle is
384385
let progMsg = "Setting up " <> T.pack (takeBaseName (cradleRootDir cradle))
385386
<> " (for " <> T.pack lfp <> ")"
386-
eopts <- withIndefiniteProgress progMsg NotCancellable $
387-
cradleToOptsAndLibDir cradle cfp
387+
eopts <- mRunLspTCallback lspEnv (withIndefiniteProgress progMsg NotCancellable) $
388+
cradleToOptsAndLibDir cradle cfp
388389

389390
logDebug logger $ T.pack ("Session loading result: " <> show eopts)
390391
case eopts of
@@ -794,24 +795,12 @@ getCacheDirsDefault prefix opts = do
794795
cacheDir :: String
795796
cacheDir = "ghcide"
796797

797-
notifyUserImplicitCradle:: FilePath -> FromServerMessage
798-
notifyUserImplicitCradle fp =
799-
NotShowMessage $
800-
NotificationMessage "2.0" WindowShowMessage $ ShowMessageParams MtInfo $
801-
"No [cradle](https://github.com/mpickering/hie-bios#hie-bios) found for "
802-
<> T.pack fp <>
803-
".\n Proceeding with [implicit cradle](https://hackage.haskell.org/package/implicit-hie).\n" <>
804-
"You should ignore this message, unless you see a 'Multi Cradle: No prefixes matched' error."
805-
806-
notifyCradleLoaded :: FilePath -> FromServerMessage
807-
notifyCradleLoaded fp =
808-
NotCustomServer $
809-
NotificationMessage "2.0" (CustomServerMethod cradleLoadedMethod) $
810-
toJSON fp
811-
812-
cradleLoadedMethod :: T.Text
813-
cradleLoadedMethod = "ghcide/cradle/loaded"
814-
798+
notifyUserImplicitCradle:: FilePath -> ShowMessageParams
799+
notifyUserImplicitCradle fp =ShowMessageParams MtWarning $
800+
"No [cradle](https://github.com/mpickering/hie-bios#hie-bios) found for "
801+
<> T.pack fp <>
802+
".\n Proceeding with [implicit cradle](https://hackage.haskell.org/package/implicit-hie).\n"<>
803+
"You should ignore this message, unless you see a 'Multi Cradle: No prefixes matched' error."
815804
----------------------------------------------------------------------------------------------------
816805

817806
data PackageSetupException

0 commit comments

Comments
 (0)