Upgrade to lsp-1.0

cabal.project

@@ -12,7 +12,6 @@ packages:
          ./plugins/hls-retrie-plugin
          ./plugins/hls-haddock-comments-plugin
          ./plugins/hls-splice-plugin
-
 tests: true
 
 package *
@@ -23,6 +22,22 @@ package haskell-language-server
 package ghcide
   test-show-details: direct
 
+source-repository-package
+    type: git
+    location: https://github.com/wz1000/haskell-lsp.git
+    tag: f42dd88fc1228ce01c0c938a2e2d9a25f425f755
+    subdir: lsp-types
+
+source-repository-package
+    type: git
+    location: https://github.com/wz1000/haskell-lsp.git
+    tag: f42dd88fc1228ce01c0c938a2e2d9a25f425f755
+
+source-repository-package
+    type: git
+    location: https://github.com/wz1000/lsp-test.git
+    tag: 7cef3a40e4774016c464d43b2a79c2bd6ef084d3
+
 write-ghc-environment-files: never
 
 index-state: 2021-02-08T19:11:03Z

ghcide/.hlint.yaml

@@ -98,6 +98,7 @@
   - default: false
   - {name: [-Wno-missing-signatures, -Wno-orphans, -Wno-overlapping-patterns, -Wno-incomplete-patterns, -Wno-missing-fields, -Wno-unused-matches]}
   - {name: [-Wno-dodgy-imports,-Wno-incomplete-uni-patterns], within: [Main, Development.IDE.GHC.Compat, Development.Benchmark.Rules]}
+  - {name: [-Wno-deprecations, -Wno-unticked-promoted-constructors], within: [Main, Experiments]}
 # - modules:
 #   - {name: [Data.Set, Data.HashSet], as: Set} # if you import Data.Set qualified, it must be as 'Set'
 #   - {name: Control.Arrow, within: []} # Certain modules are banned entirely

ghcide/bench/lib/Experiments.hs

@@ -1,7 +1,9 @@
 {-# LANGUAGE ConstraintKinds #-}
+{-# LANGUAGE GADTs #-}
 {-# LANGUAGE ExistentialQuantification #-}
 {-# LANGUAGE ImplicitParams #-}
 {-# LANGUAGE ImpredicativeTypes #-}
+{-# OPTIONS_GHC -Wno-deprecations -Wno-unticked-promoted-constructors #-}
 
 module Experiments
 ( Bench(..)
@@ -23,16 +25,16 @@ import Control.Applicative.Combinators (skipManyTill)
 import Control.Exception.Safe (IOException, handleAny, try)
 import Control.Monad.Extra
 import Control.Monad.IO.Class
-import Data.Aeson (Value(Null))
+import Data.Aeson (Value(Null), toJSON)
 import Data.List
 import Data.Maybe
 import qualified Data.Text as T
 import Data.Version
 import Development.IDE.Plugin.Test
 import Experiments.Types
-import Language.Haskell.LSP.Test
-import Language.Haskell.LSP.Types
-import Language.Haskell.LSP.Types.Capabilities
+import Language.LSP.Test
+import Language.LSP.Types
+import Language.LSP.Types.Capabilities
 import Numeric.Natural
 import Options.Applicative
 import System.Directory
@@ -79,13 +81,13 @@ experiments =
           isJust <$> getHover doc (fromJust identifierP),
       ---------------------------------------------------------------------------------------
       bench "getDefinition" $ allWithIdentifierPos $ \DocumentPositions{..} ->
-        not . null <$> getDefinitions doc (fromJust identifierP),
+        either (not . null) (not . null) . toEither <$> getDefinitions doc (fromJust identifierP),
       ---------------------------------------------------------------------------------------
       bench "getDefinition after edit" $ \docs -> do
           forM_ docs $ \DocumentPositions{..} ->
             changeDoc doc [charEdit stringLiteralP]
           flip allWithIdentifierPos docs $ \DocumentPositions{..} ->
-            not . null <$> getDefinitions doc (fromJust identifierP),
+            either (not . null) (not . null) . toEither <$> getDefinitions doc (fromJust identifierP),
       ---------------------------------------------------------------------------------------
       bench "documentSymbols" $ allM $ \DocumentPositions{..} -> do
         fmap (either (not . null) (not . null)) . getDocumentSymbols $ doc,
@@ -148,7 +150,7 @@ experiments =
         ( \docs -> do
             Just hieYaml <- uriToFilePath <$> getDocUri "hie.yaml"
             liftIO $ appendFile hieYaml "##\n"
-            sendNotification WorkspaceDidChangeWatchedFiles $ DidChangeWatchedFilesParams $
+            sendNotification SWorkspaceDidChangeWatchedFiles $ DidChangeWatchedFilesParams $
                 List [ FileEvent (filePathToUri "hie.yaml") FcChanged ]
             forM_ docs $ \DocumentPositions{..} ->
               changeDoc doc [charEdit stringLiteralP]
@@ -163,7 +165,7 @@ experiments =
         (\docs -> do
             Just hieYaml <- uriToFilePath <$> getDocUri "hie.yaml"
             liftIO $ appendFile hieYaml "##\n"
-            sendNotification WorkspaceDidChangeWatchedFiles $ DidChangeWatchedFilesParams $
+            sendNotification SWorkspaceDidChangeWatchedFiles $ DidChangeWatchedFilesParams $
                 List [ FileEvent (filePathToUri "hie.yaml") FcChanged ]
             flip allWithIdentifierPos docs $ \DocumentPositions{..} -> isJust <$> getHover doc (fromJust identifierP)
         )
@@ -359,7 +361,9 @@ waitForProgressDone :: Session ()
 waitForProgressDone = loop
   where
     loop = do
-      void (skipManyTill anyMessage message :: Session WorkDoneProgressEndNotification)
+      ~() <- skipManyTill anyMessage $ satisfyMaybe $ \case
+        FromServerMess SProgress (NotificationMessage _ _ (ProgressParams _ (End _))) -> Just ()
+        _ -> Nothing
       done <- null <$> getIncompleteProgressSessions
       unless done loop
 
@@ -393,8 +397,9 @@ runBench runSess b = handleAny (\e -> print e >> return badRun)
             else do
                 output (showDuration t)
                 -- Wait for the delayed actions to finish
-                waitId <- sendRequest (CustomClientMethod "test") WaitForShakeQueue
-                (td, resp) <- duration $ skipManyTill anyMessage $ responseForId waitId
+                let m = SCustomMethod "ghcide/blocking/queue"
+                waitId <- sendRequest m (toJSON WaitForShakeQueue)
+                (td, resp) <- duration $ skipManyTill anyMessage $ responseForId m waitId
                 case resp of
                     ResponseMessage{_result=Right Null} -> do
                       loop (userWaits+t) (delayedWork+td) (n -1)
@@ -562,7 +567,7 @@ searchSymbol doc@TextDocumentIdentifier{_uri} fileContents pos = do
       checkDefinitions pos = do
         defs <- getDefinitions doc pos
         case defs of
-            [Location uri _] -> return $ uri /= _uri
+            (InL [Location uri _]) -> return $ uri /= _uri
             _ -> return False
       checkCompletions pos =
         not . null <$> getCompletions doc pos

ghcide/exe/Main.hs

@@ -112,8 +112,8 @@ main = do
                       , optOTMemoryProfiling = IdeOTMemoryProfiling argsOTMemoryProfiling
                       , optTesting = IdeTesting argsTesting
                       , optShakeOptions = (optShakeOptions defOptions){shakeThreads = argsThreads}
-                      , optCheckParents = checkParents config
-                      , optCheckProject = checkProject config
+                      , optCheckParents = pure $ checkParents config
+                      , optCheckProject = pure $ checkProject config
                       }
                 }
 

ghcide/ghcide.cabal

@@ -46,6 +46,8 @@ library
         data-default,
         deepseq,
         directory,
+        dependent-map,
+        dependent-sum,
         dlist,
         extra >= 1.7.4,
         fuzzy,
@@ -55,12 +57,12 @@ library
         Glob,
         haddock-library >= 1.8,
         hashable,
-        haskell-lsp-types == 0.23.*,
-        haskell-lsp == 0.23.*,
         hie-compat,
         hls-plugin-api >= 0.7,
         lens,
         hiedb == 0.3.0.1,
+        lsp-types == 1.0.*,
+        lsp == 1.0.*,
         mtl,
         network-uri,
         parallel,
@@ -88,7 +90,9 @@ library
         vector,
         bytestring-encoding,
         opentelemetry >=0.6.1,
-        heapsize ==0.3.*
+        heapsize ==0.3.*,
+        unliftio,
+        unliftio-core
     if flag(ghc-lib)
       build-depends:
         ghc-lib >= 8.8,
@@ -131,6 +135,9 @@ library
         TupleSections
         TypeApplications
         ViewPatterns
+        DataKinds
+        TypeOperators
+        KindSignatures
 
     hs-source-dirs:
         src
@@ -160,7 +167,6 @@ library
         Development.IDE.LSP.HoverDefinition
         Development.IDE.LSP.LanguageServer
         Development.IDE.LSP.Outline
-        Development.IDE.LSP.Protocol
         Development.IDE.LSP.Server
         Development.IDE.Spans.Common
         Development.IDE.Spans.Documentation
@@ -205,9 +211,8 @@ library
         Development.IDE.LSP.Notifications
         Development.IDE.Plugin.CodeAction.PositionIndexed
         Development.IDE.Plugin.Completions.Logic
-        Development.IDE.Plugin.HLS.Formatter
         Development.IDE.Types.Action
-    ghc-options: -Wall -Wno-name-shadowing -Wincomplete-uni-patterns
+    ghc-options: -Wall -Wno-name-shadowing -Wincomplete-uni-patterns -Wno-unticked-promoted-constructors
 
 executable ghcide-test-preprocessor
     default-language: Haskell2010
@@ -285,8 +290,8 @@ executable ghcide
         safe-exceptions,
         ghc,
         hashable,
-        haskell-lsp,
-        haskell-lsp-types,
+        lsp,
+        lsp-types,
         heapsize,
         hie-bios,
         hls-plugin-api,
@@ -346,12 +351,12 @@ test-suite ghcide-tests
         ghcide,
         ghc-typelits-knownnat,
         haddock-library,
-        haskell-lsp,
-        haskell-lsp-types,
+        lsp,
+        lsp-types,
         hls-plugin-api,
         network-uri,
         lens,
-        lsp-test >= 0.12.0.0 && < 0.13,
+        lsp-test >= 0.11.0.6 && < 0.13,
         optparse-applicative,
         process,
         QuickCheck,
@@ -372,7 +377,7 @@ test-suite ghcide-tests
           record-hasfield
     hs-source-dirs: test/cabal test/exe test/src bench/lib
     include-dirs: include
-    ghc-options: -threaded -Wall -Wno-name-shadowing -O0
+    ghc-options: -threaded -Wall -Wno-name-shadowing -O0 -Wno-unticked-promoted-constructors
     main-is: Main.hs
     other-modules:
         Development.IDE.Test
@@ -408,7 +413,7 @@ executable ghcide-bench
         extra,
         filepath,
         ghcide,
-        lsp-test >= 0.12.0.0 && < 0.13,
+        lsp-test >= 0.11.0.6 && < 0.13,
         optparse-applicative,
         process,
         safe-exceptions,

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

@@ -60,9 +60,8 @@ import qualified HIE.Bios as HieBios
 import HIE.Bios.Environment hiding (getCacheDir)
 import HIE.Bios.Types
 import Hie.Implicit.Cradle (loadImplicitHieCradle)
-import Language.Haskell.LSP.Core
-import Language.Haskell.LSP.Messages
-import Language.Haskell.LSP.Types
+import Language.LSP.Server
+import Language.LSP.Types
 import System.Directory
 import qualified System.Directory.Extra as IO
 import System.FilePath
@@ -208,12 +207,11 @@ loadSessionWithOptions SessionLoadingOptions{..} dir = do
   runningCradle <- newVar dummyAs :: IO (Var (Async (IdeResult HscEnvEq,[FilePath])))
 
   return $ do
-    extras@ShakeExtras{logger, eventer, restartShakeSession,
-                       withIndefiniteProgress, ideNc, knownTargetsVar
+    extras@ShakeExtras{logger, restartShakeSession, ideNc, knownTargetsVar, lspEnv
                       } <- getShakeExtras
 
     IdeOptions{ optTesting = IdeTesting optTesting
-              , optCheckProject = checkProject
+              , optCheckProject = getCheckProject
               , optCustomDynFlags
               , optExtensions
               } <- getIdeOptions
@@ -358,6 +356,7 @@ loadSessionWithOptions SessionLoadingOptions{..} dir = do
           restartShakeSession []
 
           -- Typecheck all files in the project on startup
+          checkProject <- getCheckProject
           unless (null cs || not checkProject) $ do
                 cfps' <- liftIO $ filterM (IO.doesFileExist . fromNormalizedFilePath) (concatMap targetLocations cs)
                 void $ shakeEnqueue extras $ mkDelayedAction "InitialLoad" Debug $ void $ do
@@ -376,17 +375,19 @@ loadSessionWithOptions SessionLoadingOptions{..} dir = do
            lfp <- flip makeRelative cfp <$> getCurrentDirectory
            logInfo logger $ T.pack ("Consulting the cradle for " <> show lfp)
 
-           when (isNothing hieYaml) $ eventer $ notifyUserImplicitCradle lfp
+           when (isNothing hieYaml) $ mRunLspT lspEnv $
+             sendNotification SWindowShowMessage $ notifyUserImplicitCradle lfp
 
            cradle <- maybe (loadImplicitHieCradle $ addTrailingPathSeparator dir) loadCradle hieYaml
 
-           when optTesting $ eventer $ notifyCradleLoaded lfp
+           when optTesting $ mRunLspT lspEnv $
+            sendNotification (SCustomMethod "ghcide/cradle/loaded") (toJSON cfp)
 
            -- Display a user friendly progress message here: They probably don't know what a cradle is
            let progMsg = "Setting up " <> T.pack (takeBaseName (cradleRootDir cradle))
                          <> " (for " <> T.pack lfp <> ")"
-           eopts <- withIndefiniteProgress progMsg NotCancellable $
-             cradleToOptsAndLibDir cradle cfp
+           eopts <- mRunLspTCallback lspEnv (withIndefiniteProgress progMsg NotCancellable) $
+              cradleToOptsAndLibDir cradle cfp
 
            logDebug logger $ T.pack ("Session loading result: " <> show eopts)
            case eopts of
@@ -796,24 +797,12 @@ getCacheDirsDefault prefix opts = do
 cacheDir :: String
 cacheDir = "ghcide"
 
-notifyUserImplicitCradle:: FilePath -> FromServerMessage
-notifyUserImplicitCradle fp =
-    NotShowMessage $
-    NotificationMessage "2.0" WindowShowMessage $ ShowMessageParams MtInfo $
-      "No [cradle](https://github.com/mpickering/hie-bios#hie-bios) found for "
-      <> T.pack fp <>
-      ".\n Proceeding with [implicit cradle](https://hackage.haskell.org/package/implicit-hie).\n" <>
-      "You should ignore this message, unless you see a 'Multi Cradle: No prefixes matched' error."
-
-notifyCradleLoaded :: FilePath -> FromServerMessage
-notifyCradleLoaded fp =
-    NotCustomServer $
-    NotificationMessage "2.0" (CustomServerMethod cradleLoadedMethod) $
-    toJSON fp
-
-cradleLoadedMethod :: T.Text
-cradleLoadedMethod = "ghcide/cradle/loaded"
-
+notifyUserImplicitCradle:: FilePath -> ShowMessageParams
+notifyUserImplicitCradle fp =ShowMessageParams MtWarning $
+  "No [cradle](https://github.com/mpickering/hie-bios#hie-bios) found for "
+  <> T.pack fp <>
+  ".\n Proceeding with [implicit cradle](https://hackage.haskell.org/package/implicit-hie).\n"<>
+  "You should ignore this message, unless you see a 'Multi Cradle: No prefixes matched' error."
 ----------------------------------------------------------------------------------------------------
 
 data PackageSetupException