Add ability for plugins to handle file change notifications

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/bench/lib/Experiments.hs

@@ -1,4 +1,5 @@
 {-# LANGUAGE ConstraintKinds #-}
+{-# LANGUAGE GADTs #-}
 {-# LANGUAGE ExistentialQuantification #-}
 {-# LANGUAGE ImplicitParams #-}
 {-# LANGUAGE ImpredicativeTypes #-}
@@ -23,16 +24,16 @@ import Control.Applicative.Combinators (skipManyTill)
 import Control.Exception.Safe
 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
@@ -78,13 +79,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,
@@ -147,7 +148,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]
@@ -162,7 +163,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)
         )
@@ -358,7 +359,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
 
@@ -392,8 +395,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)
@@ -559,7 +563,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

@@ -32,10 +32,9 @@ import Development.IDE.Plugin
 import Development.IDE.Plugin.Test as Test
 import Development.IDE.Session (loadSession, setInitialDynFlags, getHieDbLoc, runWithDb)
 import Development.Shake (ShakeOptions (shakeThreads))
-import qualified Language.Haskell.LSP.Core as LSP
-import Language.Haskell.LSP.Messages
-import Language.Haskell.LSP.Types
-import Language.Haskell.LSP.Types.Lens (params, initializationOptions)
+import qualified Language.LSP.Server as LSP
+import Language.LSP.Types
+import Language.LSP.Types.Lens (params, initializationOptions)
 import Development.IDE.LSP.LanguageServer
 import qualified System.Directory.Extra as IO
 import System.Environment
@@ -117,22 +116,19 @@ runIde Arguments{..} hiedb hiechan = do
 
     let plugins = hlsPlugin
             <> if argsTesting then Test.plugin else mempty
-        onInitialConfiguration :: InitializeRequest -> Either T.Text Config
-        onInitialConfiguration x = case x ^. params . initializationOptions of
-          Nothing -> Right def
-          Just v -> case J.fromJSON v of
-            J.Error err -> Left $ T.pack err
-            J.Success a -> Right a
-        onConfigurationChange = const $ Left "Updating Not supported"
         options = def { LSP.executeCommandCommands = Just hlsCommands
                       , LSP.completionTriggerCharacters = Just "."
                       }
+        onConfigurationChange _ide v = pure $ case J.fromJSON v of
+          J.Error err -> Left $ T.pack err
+          J.Success a -> Right a
+
     case argFilesOrCmd of
       Nothing -> do
         t <- offsetTime
         hPutStrLn stderr "Starting LSP server..."
         hPutStrLn stderr "If you are seeing this in a terminal, you probably should have run ghcide WITHOUT the --lsp option!"
-        runLanguageServer options (pluginHandler plugins) onInitialConfiguration onConfigurationChange $ \getLspId event vfs caps wProg wIndefProg getConfig rootPath -> do
+        runLanguageServer options onConfigurationChange (pluginHandlers plugins) $ \env vfs rootPath -> do
             t <- t
             hPutStrLn stderr $ "Started LSP server in " ++ showDuration t
 
@@ -144,15 +140,16 @@ runIde Arguments{..} hiedb hiechan = do
                           `catchAny` (\e -> (hPutStrLn stderr $ "setInitialDynFlags: " ++ displayException e) >> pure Nothing)
 
             sessionLoader <- loadSession $ fromMaybe dir rootPath
-            config <- fromMaybe def <$> getConfig
+            let config = fromMaybe def <$> (LSP.runLspT env LSP.getConfig)
+            caps <- LSP.runLspT env LSP.getClientCapabilities
             let options = defOptions
                     { optReportProgress    = clientSupportsProgress caps
                     , optShakeProfiling    = argsShakeProfiling
                     , optOTMemoryProfiling = IdeOTMemoryProfiling argsOTMemoryProfiling
                     , optTesting           = IdeTesting argsTesting
                     , optShakeOptions      = (optShakeOptions defOptions){shakeThreads = argsThreads}
-                    , optCheckParents      = checkParents config
-                    , optCheckProject      = checkProject config
+                    , optCheckParents      = checkParents <$> config
+                    , optCheckProject      = checkProject <$> config
                     }
                 defOptions = defaultIdeOptions sessionLoader
                 logLevel = if argsVerbose then minBound else Info
@@ -165,8 +162,7 @@ runIde Arguments{..} hiedb hiechan = do
                   -- Shake database restart, i.e. on every user edit.
                   unless argsDisableKick $
                     action kick
-            initialise caps rules
-                getLspId event wProg wIndefProg (logger logLevel) debouncer options vfs hiedb hiechan
+            initialise rules (Just env) (logger logLevel) debouncer options vfs hiedb hiechan
       Just argFiles -> do
         -- GHC produces messages with UTF8 in them, so make sure the terminal doesn't error
         hSetEncoding stdout utf8
@@ -197,12 +193,12 @@ runIde Arguments{..} hiedb hiechan = do
                     -- , optOTMemoryProfiling = IdeOTMemoryProfiling argsOTMemoryProfiling
                     , optTesting           = IdeTesting argsTesting
                     , optShakeOptions      = (optShakeOptions defOptions){shakeThreads = argsThreads}
-                    , optCheckParents      = NeverCheck
-                    , optCheckProject      = False
+                    , optCheckParents      = pure NeverCheck
+                    , optCheckProject      = pure False
                     }
             defOptions = defaultIdeOptions sessionLoader
             logLevel = if argsVerbose then minBound else Info
-        ide <- initialise def mainRule (pure $ IdInt 0) (showEvent lock) dummyWithProg (const (const id)) (logger logLevel) debouncer options vfs hiedb hiechan
+        ide <- initialise mainRule Nothing (logger logLevel) debouncer (defaultIdeOptions sessionLoader) vfs hiedb hiechan
 
         putStrLn "\nStep 4/4: Type checking the files"
         setFilesOfInterest ide $ HashMap.fromList $ map ((, OnDisk) . toNormalizedFilePath') files

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
@@ -144,8 +151,8 @@ library
         Development.IDE.Core.OfInterest
         Development.IDE.Core.PositionMapping
         Development.IDE.Core.Preprocessor
-        Development.IDE.Core.Rules
         Development.IDE.Core.RuleTypes
+        Development.IDE.Core.Rules
         Development.IDE.Core.Service
         Development.IDE.Core.Shake
         Development.IDE.Core.Tracing
@@ -157,12 +164,22 @@ library
         Development.IDE.Import.DependencyInformation
         Development.IDE.LSP.HoverDefinition
         Development.IDE.LSP.LanguageServer
+        Development.IDE.LSP.Notifications
         Development.IDE.LSP.Outline
         Development.IDE.LSP.Protocol
         Development.IDE.LSP.Server
+        Development.IDE.Plugin
+        Development.IDE.Plugin.CodeAction
+        Development.IDE.Plugin.CodeAction.ExactPrint
+        Development.IDE.Plugin.Completions
+        Development.IDE.Plugin.Completions.Types
+        Development.IDE.Plugin.HLS
+        Development.IDE.Plugin.HLS.GhcIde
+        Development.IDE.Plugin.Test
+        Development.IDE.Plugin.TypeLenses
+        Development.IDE.Spans.AtPoint
         Development.IDE.Spans.Common
         Development.IDE.Spans.Documentation
-        Development.IDE.Spans.AtPoint
         Development.IDE.Spans.LocalBindings
         Development.IDE.Types.Diagnostics
         Development.IDE.Types.Exports
@@ -172,15 +189,6 @@ library
         Development.IDE.Types.Logger
         Development.IDE.Types.Options
         Development.IDE.Types.Shake
-        Development.IDE.Plugin
-        Development.IDE.Plugin.Completions
-        Development.IDE.Plugin.Completions.Types
-        Development.IDE.Plugin.CodeAction
-        Development.IDE.Plugin.CodeAction.ExactPrint
-        Development.IDE.Plugin.HLS
-        Development.IDE.Plugin.HLS.GhcIde
-        Development.IDE.Plugin.Test
-        Development.IDE.Plugin.TypeLenses
 
     -- Unfortunately, we cannot use loadSession with ghc-lib since hie-bios uses
     -- the real GHC library and the types are incompatible. Furthermore, when
@@ -201,12 +209,11 @@ library
         Development.IDE.GHC.CPP
         Development.IDE.GHC.Warnings
         Development.IDE.Import.FindImports
-        Development.IDE.LSP.Notifications
+        -- 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
@@ -283,8 +290,8 @@ executable ghcide
         safe-exceptions,
         ghc,
         hashable,
-        haskell-lsp,
-        haskell-lsp-types,
+        lsp,
+        lsp-types,
         heapsize,
         hie-bios,
         hls-plugin-api,
@@ -343,12 +350,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,
@@ -405,7 +412,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,