Working on Plugin support for haskell-language-server (#477)

* Working on Plugin support for hls

Fix PluginCommand reply type for executeCommand needs

* Remove PluginCommand

It will move to haskell-language-server instead

* Make azure CI hlint happy

By removing explicit OverloadedStrings pragma, in favour of the one already
enabled in the cabal file.

* Remove unneeded 'do'

* Fix more nits from review

Author: alanz

exe/Main.hs

@@ -35,6 +35,7 @@ import Development.IDE.Plugin.Completions as Completions
 import Development.IDE.Plugin.CodeAction as CodeAction
 import qualified Data.Text as T
 import qualified Data.Text.IO as T
+import qualified Language.Haskell.LSP.Core as LSP
 import Language.Haskell.LSP.Messages
 import Language.Haskell.LSP.Types (LspId(IdInt))
 import Data.Version
@@ -84,12 +85,15 @@ main = do
     let plugins = Completions.plugin <> CodeAction.plugin
         onInitialConfiguration = const $ Right ()
         onConfigurationChange  = const $ Right ()
+        options = def { LSP.executeCommandCommands = Just ["typesignature.add"]
+                      , LSP.completionTriggerCharacters = Just "."
+                      }
 
     if argLSP then 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 def (pluginHandler plugins) onInitialConfiguration onConfigurationChange $ \getLspId event vfs caps -> do
+        runLanguageServer options (pluginHandler plugins) onInitialConfiguration onConfigurationChange $ \getLspId event vfs caps -> do
             t <- t
             hPutStrLn stderr $ "Started LSP server in " ++ showDuration t
             let options = (defaultIdeOptions $ loadSession dir)

src/Development/IDE/LSP/LanguageServer.hs

@@ -149,10 +149,10 @@ runLanguageServer options userHandlers onInitialConfig onConfigChange getIdeStat
                     ResponseAndRequest x@RequestMessage{_id, _params} wrap wrapNewReq act ->
                         checkCancelled ide clearReqId waitForCancel lspFuncs wrap act x _id _params $
                             \(res, newReq) -> do
-                            sendFunc $ wrap $ ResponseMessage "2.0" (responseId _id) (Just res) Nothing
-                            case newReq of
-                                Nothing -> return ()
-                                Just (rm, newReqParams) -> do
+                                case res of
+                                    Left e  -> sendFunc $ wrap $ ResponseMessage "2.0" (responseId _id) Nothing (Just e)
+                                    Right r -> sendFunc $ wrap $ ResponseMessage "2.0" (responseId _id) (Just r) Nothing
+                                whenJust newReq $ \(rm, newReqParams) -> do
                                     reqId <- getNextReqId
                                     sendFunc $ wrapNewReq $ RequestMessage "2.0" reqId rm newReqParams
                     InitialParams x@RequestMessage{_id, _params} act -> do
@@ -222,15 +222,13 @@ data Message c
     -- | Used for cases in which we need to send not only a response,
     --   but also an additional request to the client.
     --   For example, 'executeCommand' may generate an 'applyWorkspaceEdit' request.
-    | forall m rm req resp newReqParams newReqBody . (Show m, Show rm, Show req) => ResponseAndRequest (RequestMessage m req resp) (ResponseMessage resp -> FromServerMessage) (RequestMessage rm newReqParams newReqBody -> FromServerMessage) (LSP.LspFuncs c -> IdeState -> req -> IO (resp, Maybe (rm, newReqParams)))
+    | forall m rm req resp newReqParams newReqBody . (Show m, Show rm, Show req) => ResponseAndRequest (RequestMessage m req resp) (ResponseMessage resp -> FromServerMessage) (RequestMessage rm newReqParams newReqBody -> FromServerMessage) (LSP.LspFuncs c -> IdeState -> req -> IO (Either ResponseError resp, Maybe (rm, newReqParams)))
     | forall m req . (Show m, Show req) => Notification (NotificationMessage m req) (LSP.LspFuncs c -> IdeState -> req -> IO ())
     -- | Used for the InitializeRequest only, where the response is generated by the LSP core handler.
     | InitialParams InitializeRequest (LSP.LspFuncs c -> IdeState -> InitializeParams -> IO ())
 
 modifyOptions :: LSP.Options -> LSP.Options
 modifyOptions x = x{ LSP.textDocumentSync   = Just $ tweakTDS origTDS
-                   , LSP.executeCommandCommands = Just ["typesignature.add"]
-                   , LSP.completionTriggerCharacters = Just "."
                    }
     where
         tweakTDS tds = tds{_openClose=Just True, _change=Just TdSyncIncremental, _save=Just $ SaveOptions Nothing}

src/Development/IDE/LSP/Server.hs

@@ -29,7 +29,7 @@ data WithMessage c = WithMessage
         (Show m, Show rm, Show req, Show newReqParams, Show newReqBody) =>
         (ResponseMessage resp -> LSP.FromServerMessage) -> -- how to wrap a response
         (RequestMessage rm newReqParams newReqBody -> LSP.FromServerMessage) -> -- how to wrap the additional req
-        (LSP.LspFuncs c -> IdeState -> req -> IO (resp, Maybe (rm, newReqParams))) -> -- actual work
+        (LSP.LspFuncs c -> IdeState -> req -> IO (Either ResponseError resp, Maybe (rm, newReqParams))) -> -- actual work
         Maybe (LSP.Handler (RequestMessage m req resp))
     , withInitialize :: (LSP.LspFuncs c -> IdeState -> InitializeParams -> IO ())
                      -> Maybe (LSP.Handler InitializeRequest)

src/Development/IDE/Plugin/CodeAction.hs

@@ -103,14 +103,14 @@ executeAddSignatureCommand
     :: LSP.LspFuncs c
     -> IdeState
     -> ExecuteCommandParams
-    -> IO (Value, Maybe (ServerMethod, ApplyWorkspaceEditParams))
+    -> IO (Either ResponseError Value, Maybe (ServerMethod, ApplyWorkspaceEditParams))
 executeAddSignatureCommand _lsp _ideState ExecuteCommandParams{..}
     | _command == "typesignature.add"
     , Just (List [edit]) <- _arguments
     , Success wedit <- fromJSON edit
-    = return (Null, Just (WorkspaceApplyEdit, ApplyWorkspaceEditParams wedit))
+    = return (Right Null, Just (WorkspaceApplyEdit, ApplyWorkspaceEditParams wedit))
     | otherwise
-    = return (Null, Nothing)
+    = return (Right Null, Nothing)
 
 suggestAction
   :: Maybe DynFlags