[feat] make hls speak websocket

Author: MangoIV

exe/Wrapper.hs

@@ -98,7 +98,7 @@ main = do
             Left err -> do
               T.hPutStrLn stderr (prettyError err NoShorten)
               case args of
-                Ghcide (GhcideArguments { argsCommand = Main.LSP }) ->
+                Ghcide (GhcideArguments { argsCommand = Main.LSP Main.StdIO }) ->
                     launchErrorLSP recorder (prettyError err Shorten)
 
                 _ -> exitFailure
@@ -274,10 +274,6 @@ launchErrorLSP recorder errorMsg = do
   cwd <- getCurrentDirectory
   let defaultArguments = Main.defaultArguments (cmapWithPrio pretty recorder) cwd (IdePlugins [])
 
-  inH <- Main.argsHandleIn defaultArguments
-
-  outH <- Main.argsHandleOut defaultArguments
-
   let parseConfig cfg _ = Right cfg
       onConfigChange _ = pure ()
 
@@ -302,14 +298,16 @@ launchErrorLSP recorder errorMsg = do
         let interpretHandler (env,  _st) = LSP.Iso (LSP.runLspT env . unErrorLSPM) liftIO
         pure (doInitialize, asyncHandlers, interpretHandler)
 
-  runLanguageServer (cmapWithPrio pretty recorder)
-    (Main.argsLspOptions defaultArguments)
-    inH
-    outH
-    (Main.argsDefaultHlsConfig defaultArguments)
-    parseConfig
-    onConfigChange
-    setup
+  let runServerWithCommunication comm =
+          runLanguageServer (cmapWithPrio pretty recorder)
+            (Main.argsLspOptions defaultArguments)
+            comm
+            (Main.argsDefaultHlsConfig defaultArguments)
+            parseConfig
+            onConfigChange
+            setup
+
+  Main.commKindToCommunication (cmapWithPrio pretty recorder) runServerWithCommunication Main.StdIO
 
 exitHandler :: IO () -> LSP.Handlers (ErrorLSPM c)
 exitHandler exit = LSP.notificationHandler SMethod_Exit $ const $ liftIO exit

flake.nix

@@ -66,6 +66,7 @@
           # This removes a rebuild with a different GHC version. The drawback of
           # this approach is that our shell may pull two GHC versions in scope.
           buildInputs = [
+            hpkgs.haskell-language-server
             # Compiler toolchain
             hpkgs.ghc
             hpkgs.haskell-language-server

ghcide/exe/Arguments.hs

@@ -4,7 +4,8 @@
 module Arguments(Arguments(..), getArguments) where
 
 import           Development.IDE      (IdeState)
-import           Development.IDE.Main (Command (..), commandP)
+import           Development.IDE.Main (Command (..), CommunicationKind (..),
+                                       commandP)
 import           Ide.Types            (IdePlugins)
 import           Options.Applicative
 
@@ -44,4 +45,4 @@ arguments plugins = Arguments
       <*> switch (long "conservative-change-tracking" <> help "disable reactive change tracking (for testing/debugging)")
       where
           checkCommand = Check <$> many (argument str (metavar "FILES/DIRS..."))
-          lspCommand = LSP <$ flag' True (long "lsp" <> help "Start talking to an LSP client")
+          lspCommand = LSP StdIO <$ flag' True (long "lsp" <> help "Start talking to an LSP client")

ghcide/ghcide.cabal

@@ -51,6 +51,7 @@ library
     , bytestring
     , case-insensitive
     , co-log-core
+    , websockets
     , containers
     , cryptohash-sha1              >=0.11.100 && <0.12
     , data-default

ghcide/src/Development/IDE/LSP/LanguageServer.hs

@@ -11,6 +11,7 @@ module Development.IDE.LSP.LanguageServer
     , Log(..)
     , ThreadQueue
     , runWithWorkerThreads
+    , Communication (..)
     ) where
 
 import           Control.Concurrent.STM
@@ -27,16 +28,19 @@ import           Ide.Types                             (traceWithSpan)
 import           Language.LSP.Protocol.Message
 import           Language.LSP.Protocol.Types
 import qualified Language.LSP.Server                   as LSP
-import           System.IO
 import           UnliftIO.Async
 import           UnliftIO.Concurrent
 import           UnliftIO.Directory
 import           UnliftIO.Exception
 
 import qualified Colog.Core                            as Colog
 import           Control.Exception                     (BlockedIndefinitelyOnMVar (..))
+import           Control.Exception.Backtrace           (BacktraceMechanism (..),
+                                                        setBacktraceMechanismState)
 import           Control.Monad.IO.Unlift               (MonadUnliftIO)
 import           Control.Monad.Trans.Cont              (evalContT)
+import           Data.ByteString
+import           Data.ByteString.Lazy
 import           Development.IDE.Core.IdeConfiguration
 import           Development.IDE.Core.Shake            hiding (Log)
 import           Development.IDE.Core.Tracing
@@ -82,13 +86,17 @@ instance Pretty Log where
     LogLspServer msg -> pretty msg
     LogServerShutdownMessage -> "Received shutdown message"
 
+data Communication
+  = Communication
+  { inwards  :: IO StrictByteString
+  , outwards :: LazyByteString -> IO ()
+  }
 
 runLanguageServer
     :: forall config a m. (Show config)
     => Recorder (WithPriority Log)
     -> LSP.Options
-    -> Handle -- input
-    -> Handle -- output
+    -> Communication
     -> config
     -> (config -> Value -> Either T.Text config)
     -> (config -> m config ())
@@ -97,7 +105,7 @@ runLanguageServer
                LSP.Handlers (m config),
                (LanguageContextEnv config, a) -> m config <~> IO))
     -> IO ()
-runLanguageServer recorder options inH outH defaultConfig parseConfig onConfigChange setup = do
+runLanguageServer recorder options comm defaultConfig parseConfig onConfigChange setup = do
     -- This MVar becomes full when the server thread exits or we receive exit message from client.
     -- LSP server will be canceled when it's full.
     clientMsgVar <- newEmptyMVar
@@ -120,11 +128,11 @@ runLanguageServer recorder options inH outH defaultConfig parseConfig onConfigCh
         lspCologAction = toCologActionWithPrio (cmapWithPrio LogLspServer recorder)
 
     void $ untilMVar clientMsgVar $
-          void $ LSP.runServerWithHandles
+          void $ LSP.runServerWith
             lspCologAction
             lspCologAction
-            inH
-            outH
+            (inwards comm)
+            (outwards comm)
             serverDefinition
 
 setupLSP ::