Skip to content

Commit 32dc937

Browse files
wz1000wz1000
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 0a4514a commit 32dc937

Some content is hidden

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

48 files changed

+970
-1428
lines changed

‎cabal.project

Lines changed: 3 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -12,6 +12,9 @@ packages:
1212
./plugins/hls-retrie-plugin
1313
./plugins/hls-haddock-comments-plugin
1414
./plugins/hls-splice-plugin
15+
/home/zubin/hie-lsp/haskell-lsp/
16+
/home/zubin/hie-lsp/haskell-lsp/lsp-types
17+
/home/zubin/hie-lsp/haskell-lsp/lsp-test
1518

1619
tests: true
1720

‎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" $ 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" $ \docs -> do
8485
forM_ docs $ \DocumentPositions{..} ->
@@ -358,7 +359,9 @@ waitForProgressDone :: Session ()
358359
waitForProgressDone = loop
359360
where
360361
loop = do
361-
void (skipManyTill anyMessage message :: Session WorkDoneProgressEndNotification)
362+
void $ skipManyTill anyMessage $ satisfyMaybe $ \case
363+
FromServerMess SProgress (NotificationMessage _ _ (ProgressParams _ (End _))) -> Just ()
364+
_ -> Nothing
362365
done <- null <$> getIncompleteProgressSessions
363366
unless done loop
364367

@@ -392,8 +395,9 @@ runBench runSess b = handleAny (\e -> print e >> return badRun)
392395
else do
393396
output (showDuration t)
394397
-- Wait for the delayed actions to finish
395-
waitId <- sendRequest (CustomClientMethod "test") WaitForShakeQueue
396-
(td, resp) <- duration $ skipManyTill anyMessage $ responseForId waitId
398+
let m = SCustomMethod "ghcide/blocking/queue"
399+
waitId <- sendRequest m (toJSON WaitForShakeQueue)
400+
(td, resp) <- duration $ skipManyTill anyMessage $ responseForId m waitId
397401
case resp of
398402
ResponseMessage{_result=Right Null} -> do
399403
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 & 10 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.7,
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,
@@ -204,7 +207,6 @@ library
204207
Development.IDE.LSP.Notifications
205208
Development.IDE.Plugin.CodeAction.PositionIndexed
206209
Development.IDE.Plugin.Completions.Logic
207-
Development.IDE.Plugin.HLS.Formatter
208210
Development.IDE.Types.Action
209211
ghc-options: -Wall -Wno-name-shadowing -Wincomplete-uni-patterns
210212

@@ -283,8 +285,8 @@ executable ghcide
283285
safe-exceptions,
284286
ghc,
285287
hashable,
286-
haskell-lsp,
287-
haskell-lsp-types,
288+
lsp,
289+
lsp-types,
288290
heapsize,
289291
hie-bios,
290292
hls-plugin-api,
@@ -343,12 +345,12 @@ test-suite ghcide-tests
343345
ghcide,
344346
ghc-typelits-knownnat,
345347
haddock-library,
346-
haskell-lsp,
347-
haskell-lsp-types,
348+
lsp,
349+
lsp-types,
348350
hls-plugin-api,
349351
network-uri,
350352
lens,
351-
lsp-test >= 0.12.0.0 && < 0.13,
353+
lsp-test >= 0.11.0.6 && < 0.13,
352354
optparse-applicative,
353355
process,
354356
QuickCheck,
@@ -405,7 +407,7 @@ executable ghcide-bench
405407
extra,
406408
filepath,
407409
ghcide,
408-
lsp-test >= 0.12.0.0 && < 0.13,
410+
lsp-test >= 0.11.0.6 && < 0.13,
409411
optparse-applicative,
410412
process,
411413
safe-exceptions,

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

Lines changed: 17 additions & 28 deletions
Original file line numberDiff line numberDiff line change
@@ -60,9 +60,8 @@ import qualified HIE.Bios as HieBios
6060
import HIE.Bios.Environment hiding (getCacheDir)
6161
import HIE.Bios.Types
6262
import Hie.Implicit.Cradle (loadImplicitHieCradle)
63-
import Language.Haskell.LSP.Core
64-
import Language.Haskell.LSP.Messages
65-
import Language.Haskell.LSP.Types
63+
import Language.LSP.Server
64+
import Language.LSP.Types
6665
import System.Directory
6766
import qualified System.Directory.Extra as IO
6867
import System.FilePath
@@ -208,12 +207,11 @@ loadSessionWithOptions SessionLoadingOptions{..} dir = do
208207
runningCradle <- newVar dummyAs :: IO (Var (Async (IdeResult HscEnvEq,[FilePath])))
209208

210209
return $ do
211-
extras@ShakeExtras{logger, eventer, restartShakeSession,
212-
withIndefiniteProgress, ideNc, knownTargetsVar
210+
extras@ShakeExtras{logger, restartShakeSession, ideNc, knownTargetsVar, lspEnv
213211
} <- getShakeExtras
214212

215213
IdeOptions{ optTesting = IdeTesting optTesting
216-
, optCheckProject = checkProject
214+
, optCheckProject = getCheckProject
217215
, optCustomDynFlags
218216
, optExtensions
219217
} <- getIdeOptions
@@ -358,6 +356,7 @@ loadSessionWithOptions SessionLoadingOptions{..} dir = do
358356
restartShakeSession []
359357

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

379-
when (isNothing hieYaml) $ eventer $ notifyUserImplicitCradle lfp
378+
when (isNothing hieYaml) $ mRunLspT lspEnv $
379+
sendNotification SWindowShowMessage $ notifyUserImplicitCradle lfp
380380

381381
cradle <- maybe (loadImplicitHieCradle $ addTrailingPathSeparator dir) loadCradle hieYaml
382382

383-
when optTesting $ eventer $ notifyCradleLoaded lfp
383+
when optTesting $ mRunLspT lspEnv $
384+
sendNotification (SCustomMethod "ghcide/cradle/loaded") (toJSON cfp)
384385

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

391392
logDebug logger $ T.pack ("Session loading result: " <> show eopts)
392393
case eopts of
@@ -796,24 +797,12 @@ getCacheDirsDefault prefix opts = do
796797
cacheDir :: String
797798
cacheDir = "ghcide"
798799

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

819808
data PackageSetupException

0 commit comments

Comments
 (0)