WIP

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

@@ -562,39 +562,54 @@ registerCapability ::
   Handler f m ->
   f (Maybe (RegistrationToken m))
 registerCapability method regOpts f = do
-  clientCaps <- resClientCapabilities <$> getLspEnv
   handlers <- resHandlers <$> getLspEnv
   let alreadyStaticallyRegistered = case splitClientMethod method of
         IsClientNot -> SMethodMap.member method $ notHandlers handlers
         IsClientReq -> SMethodMap.member method $ reqHandlers handlers
         IsClientEither -> error "Cannot register capability for custom methods"
-  go clientCaps alreadyStaticallyRegistered
+  go alreadyStaticallyRegistered
  where
   -- If the server has already registered statically, don't dynamically register
   -- as per the spec
-  go _clientCaps True = pure Nothing
-  go clientCaps False
-    -- First, check to see if the client supports dynamic registration on this method
-    | dynamicRegistrationSupported method clientCaps = do
-        uuid <- liftIO $ UUID.toText <$> getStdRandom random
-        let registration = L.TRegistration uuid method (Just regOpts)
-            params = L.RegistrationParams [toUntypedRegistration registration]
-            regId = RegistrationId uuid
-        rio <- askUnliftIO
+  go True = pure Nothing
+  go False = do
+    rio <- askUnliftIO
+    mtoken <- trySendRegistration method regOpts
+    case mtoken of
+      Just token@(RegistrationToken _ regId) -> do
         ~() <- case splitClientMethod method of
           IsClientNot -> modifyState resRegistrationsNot $ \oldRegs ->
             let pair = Pair regId (ClientMessageHandler (unliftIO rio . f))
-             in SMethodMap.insert method pair oldRegs
+            in SMethodMap.insert method pair oldRegs
           IsClientReq -> modifyState resRegistrationsReq $ \oldRegs ->
             let pair = Pair regId (ClientMessageHandler (\msg k -> unliftIO rio $ f msg (liftIO . k)))
-             in SMethodMap.insert method pair oldRegs
+            in SMethodMap.insert method pair oldRegs
           IsClientEither -> error "Cannot register capability for custom methods"
 
-        -- TODO: handle the scenario where this returns an error
-        _ <- sendRequest SMethod_ClientRegisterCapability params $ \_res -> pure ()
+        pure $ Just token
+      Nothing -> pure Nothing
 
-        pure (Just (RegistrationToken method regId))
-    | otherwise = pure Nothing
+trySendRegistration ::
+  forall f t (m :: Method ClientToServer t) config.
+  MonadLsp config f =>
+  SClientMethod m ->
+  RegistrationOptions m ->
+  f (Maybe (RegistrationToken m))
+trySendRegistration method regOpts = do
+  clientCaps <- resClientCapabilities <$> getLspEnv
+  -- First, check to see if the client supports dynamic registration on this method
+  if dynamicRegistrationSupported method clientCaps
+  then do
+    uuid <- liftIO $ UUID.toText <$> getStdRandom random
+    let registration = L.TRegistration uuid method (Just regOpts)
+        params = L.RegistrationParams [toUntypedRegistration registration]
+        regId = RegistrationId uuid
+
+    -- TODO: handle the scenario where this returns an error
+    _ <- sendRequest SMethod_ClientRegisterCapability params $ \_res -> pure ()
+
+    pure (Just $ RegistrationToken method regId)
+  else pure Nothing
 
 {- | Sends a @client/unregisterCapability@ request and removes the handler
  for that associated registration.

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

@@ -77,6 +77,7 @@ data LspProcessingLog
   | MessageProcessingError BSL.ByteString String
   | forall m. MissingHandler Bool (SClientMethod m)
   | ProgressCancel ProgressToken
+  | forall m. CantRegister (SMethod m)
   | Exiting
 
 deriving instance Show LspProcessingLog
@@ -93,6 +94,7 @@ instance Pretty LspProcessingLog where
       ]
   pretty (MissingHandler _ m) = "LSP: no handler for:" <+> pretty m
   pretty (ProgressCancel tid) = "LSP: cancelling action for token:" <+> pretty tid
+  pretty (CantRegister m) = "LSP: can't register dynamically for:" <+> pretty m
   pretty Exiting = "LSP: Got exit, exiting"
 
 processMessage :: (m ~ LspM config) => LogAction m (WithSeverity LspProcessingLog) -> BSL.ByteString -> m ()
@@ -428,7 +430,7 @@ handle logger m msg =
     SMethod_WorkspaceDidChangeWorkspaceFolders -> handle' logger (Just updateWorkspaceFolders) m msg
     SMethod_WorkspaceDidChangeConfiguration -> handle' logger (Just $ handleDidChangeConfiguration logger) m msg
     -- See Note [LSP configuration]
-    SMethod_Initialized -> handle' logger (Just $ \_ -> requestConfigUpdate (cmap (fmap LspCore) logger)) m msg
+    SMethod_Initialized -> handle' logger (Just $ \_ -> initialDynamicRegistrations logger >> requestConfigUpdate (cmap (fmap LspCore) logger)) m msg
     SMethod_TextDocumentDidOpen -> handle' logger (Just $ vfsFunc logger openVFS) m msg
     SMethod_TextDocumentDidChange -> handle' logger (Just $ vfsFunc logger changeFromClientVFS) m msg
     SMethod_TextDocumentDidClose -> handle' logger (Just $ vfsFunc logger closeVFS) m msg
@@ -531,6 +533,14 @@ shutdownRequestHandler :: Handler IO Method_Shutdown
 shutdownRequestHandler _req k = do
   k $ Right Null
 
+initialDynamicRegistrations :: (m ~ LspM config) => LogAction m (WithSeverity LspProcessingLog) -> m ()
+initialDynamicRegistrations logger = do
+  section <- LspT $ asks resConfigSection
+  mtoken <- trySendRegistration SMethod_WorkspaceDidChangeConfiguration (DidChangeConfigurationRegistrationOptions (Just $ InL section))
+  case mtoken of
+    Nothing -> logger <& (CantRegister SMethod_WorkspaceDidChangeConfiguration) `WithSeverity` Warning
+    Just _ -> pure ()
+
 {- | Try to find the configuration section in an object that might represent "all" the settings.
  The heuristic we use is to look for a property with the right name, and use that if we find
  it. Otherwise we fall back to the whole object.