Merge pull request #498 from haskell/mpj/caps-for-handlers

Pass the ClientCapabilities to the static handlers in ServerDefinition

README.md

@@ -70,7 +70,7 @@ main :: IO Int
 main = runServer $ ServerDefinition
   { onConfigurationChange = const $ pure $ Right ()
   , doInitialize = \env _req -> pure $ Right env
-  , staticHandlers = handlers
+  , staticHandlers = \_caps -> handlers
   , interpretHandler = \env -> Iso (runLspT env) liftIO
   , options = defaultOptions
   }

lsp-test/bench/SimpleBench.hs

@@ -35,7 +35,7 @@ server = ServerDefinition
   { onConfigurationChange = const $ const $ Right ()
   , defaultConfig = ()
   , doInitialize = \env _req -> pure $ Right env
-  , staticHandlers = handlers
+  , staticHandlers = \_caps -> handlers
   , interpretHandler = \env -> Iso (runLspT env) liftIO
   , options = defaultOptions
   }

lsp-test/func-test/FuncTest.hs

@@ -35,7 +35,7 @@ main = hspec $ do
             { onConfigurationChange = const $ const $ Right ()
             , defaultConfig = ()
             , doInitialize = \env _req -> pure $ Right env
-            , staticHandlers = handlers killVar
+            , staticHandlers = \_caps -> handlers killVar
             , interpretHandler = \env -> Iso (runLspT env) liftIO
             , options = defaultOptions
             }
@@ -82,7 +82,7 @@ main = hspec $ do
             { onConfigurationChange = const $ const $ Right ()
             , defaultConfig = ()
             , doInitialize = \env _req -> pure $ Right env
-            , staticHandlers = handlers
+            , staticHandlers = \_caps -> handlers
             , interpretHandler = \env -> Iso (runLspT env) liftIO
             , options = defaultOptions
             }

lsp-test/lsp-test.cabal

@@ -1,6 +1,6 @@
 cabal-version:      2.4
 name:               lsp-test
-version:            0.15.0.0
+version:            0.15.0.1
 synopsis:           Functional test framework for LSP servers.
 description:
   A test framework for writing tests against
@@ -59,7 +59,7 @@ library
     , filepath
     , Glob                  >=0.9   && <0.11
     , lens
-    , lsp                   ^>=2.0
+    , lsp                   ^>=2.1
     , lsp-types             ^>=2.0
     , mtl                   <2.4
     , parser-combinators    >=1.2
@@ -102,7 +102,7 @@ test-suite tests
     , filepath
     , hspec
     , lens
-    , lsp           ^>=2.0
+    , lsp           ^>=2.1
     , lsp-test
     , mtl           <2.4
     , parser-combinators

lsp-test/test/DummyServer.hs

@@ -31,7 +31,7 @@ withDummyServer f = do
         { doInitialize = \env _req -> pure $ Right env
         , defaultConfig = ()
         , onConfigurationChange = const $ pure $ Right ()
-        , staticHandlers = handlers
+        , staticHandlers = \_caps -> handlers
         , interpretHandler = \env ->
             Iso (\m -> runLspT env (runReaderT m handlerEnv)) liftIO
         , options = defaultOptions {optExecuteCommandCommands = Just ["doAnEdit"]}

lsp/ChangeLog.md

@@ -1,8 +1,12 @@
 # Revision history for lsp
 
-## 2.0.0.1
+## 2.1.0.0
 
 * Fix handling of optional methods.
+* `staticHandlers` now takes the client capabilities as an argument. 
+  These are static across the lifecycle of the server, so this allows
+  a server to decide at construction e.g. whether to provide handlers
+  for resolve methods depending on whether the client supports it.
 
 ## 2.0.0.0
 

lsp/example/Reactor.hs

@@ -96,7 +96,7 @@ run = flip E.catches handlers $ do
             J.Success cfg -> Right cfg
       , doInitialize = \env _ -> forkIO (reactor stderrLogger rin) >> pure (Right env)
       -- Handlers log to both the client and stderr
-      , staticHandlers = lspHandlers dualLogger rin
+      , staticHandlers = \_caps -> lspHandlers dualLogger rin
       , interpretHandler = \env -> Iso (runLspT env) liftIO
       , options = lspOptions
       }

lsp/example/Simple.hs

@@ -41,7 +41,7 @@ main = runServer $ ServerDefinition
   { onConfigurationChange = const $ const $ Right ()
   , defaultConfig = ()
   , doInitialize = \env _req -> pure $ Right env
-  , staticHandlers = handlers
+  , staticHandlers = \_caps -> handlers
   , interpretHandler = \env -> Iso (runLspT env) liftIO
   , options = defaultOptions
   }

lsp/lsp.cabal

@@ -1,6 +1,6 @@
 cabal-version:      2.2
 name:               lsp
-version:            2.0.0.1
+version:            2.1.0.0
 synopsis:           Haskell library for the Microsoft Language Server Protocol
 description:
   An implementation of the types, and basic message server to

lsp/src/Language/LSP/Server/Core.hs

@@ -294,10 +294,12 @@ data ServerDefinition config = forall m a.
       -- language server implementation the chance to create any processes or
       -- start new threads that may be necessary for the server lifecycle. It can
       -- also return an error in the initialization if necessary.
-    , staticHandlers :: Handlers m
+    , staticHandlers :: ClientCapabilities -> Handlers m
       -- ^ Handlers for any methods you want to statically support.
       -- The handlers here cannot be unregistered during the server's lifetime
       -- and will be registered statically in the initialize request.
+      -- The handlers provided can depend on the client capabilities, which
+      -- are static across the lifetime of the server.
     , interpretHandler :: a -> (m <~> IO)
       -- ^ How to run the handlers in your own monad of choice, @m@.
       -- It is passed the result of 'doInitialize', so typically you will want

lsp/src/Language/LSP/Server/Processing.hs

@@ -126,6 +126,7 @@ initializeRequestHandler ServerDefinition{..} vfs sendFunc req = do
     let p = req ^. L.params
         rootDir = getFirst $ foldMap First [ p ^? L.rootUri . _L >>= uriToFilePath
                                            , p ^? L.rootPath . _Just . _L <&> T.unpack ]
+        clientCaps = (p ^. L.capabilities)
 
     let initialWfs = case p ^. L.workspaceFolders of
           Just (InL xs) -> xs
@@ -152,11 +153,11 @@ initializeRequestHandler ServerDefinition{..} vfs sendFunc req = do
 
     -- Call the 'duringInitialization' callback to let the server kick stuff up
     let env = LanguageContextEnv handlers onConfigurationChange sendFunc stateVars (p ^. L.capabilities) rootDir
-        handlers = transmuteHandlers interpreter staticHandlers
+        handlers = transmuteHandlers interpreter (staticHandlers clientCaps)
         interpreter = interpretHandler initializationResult
     initializationResult <- ExceptT $ doInitialize env req
 
-    let serverCaps = inferServerCapabilities (p ^. L.capabilities) options handlers
+    let serverCaps = inferServerCapabilities clientCaps options handlers
     liftIO $ sendResp $ makeResponseMessage (req ^. L.id) (InitializeResult serverCaps (optServerInfo options))
     pure env
   where