import qualified Data.Text as T
import Language.Haskell.LSP.Capture
import Language.Haskell.LSP.Messages
-import Language.Haskell.LSP.Types as LSP hiding (error)
+import Language.Haskell.LSP.Types
+import Language.Haskell.LSP.Types.Lens as LSP hiding (error)
import Data.Aeson
import Data.Default
import Data.List
import Control.Lens hiding (List)
import Control.Monad
import System.FilePath
+import System.IO
import Language.Haskell.LSP.Test
+import Language.Haskell.LSP.Test.Compat
import Language.Haskell.LSP.Test.Files
import Language.Haskell.LSP.Test.Decoding
import Language.Haskell.LSP.Test.Messages
import Language.Haskell.LSP.Test.Server
import Language.Haskell.LSP.Test.Session
-
-- | Replays a captured client output and
-- makes sure it matches up with an expected response.
-- The session directory should have a captured session file in it
-- decode session
let unswappedEvents = map (fromJust . decode) entries
- withServer serverExe False $ \serverIn serverOut pid -> do
+ withServer serverExe False $ \serverIn serverOut serverProc -> do
+ pid <- getProcessID serverProc
events <- swapCommands pid <$> swapFiles sessionDir unswappedEvents
let clientEvents = filter isClientMsg events
mainThread <- myThreadId
sessionThread <- liftIO $ forkIO $
- runSessionWithHandles serverIn
- serverOut
+ runSessionWithHandles serverIn serverOut serverProc
(listenServer serverMsgs requestMap reqSema rspSema passSema mainThread)
def
fullCaps
sessionDir
+ (return ()) -- No finalizer cleanup
(sendMessages clientMsgs reqSema rspSema)
takeMVar passSema
killThread sessionThread
isNotification (NotCancelRequestFromServer _) = True
isNotification _ = False
--- listenServer :: [FromServerMessage]
--- -> RequestMap
--- -> MVar LspId
--- -> MVar LspIdRsp
--- -> MVar ()
--- -> ThreadId
--- -> Handle
--- -> SessionContext
--- -> IO ()
+listenServer :: [FromServerMessage]
+ -> RequestMap
+ -> MVar LspId
+ -> MVar LspIdRsp
+ -> MVar ()
+ -> ThreadId
+ -> Handle
+ -> SessionContext
+ -> IO ()
listenServer [] _ _ _ passSema _ _ _ = putMVar passSema ()
listenServer expectedMsgs reqMap reqSema rspSema passSema mainThreadId serverOut ctx = do