X-Git-Url: https://git.lukelau.me/?a=blobdiff_plain;f=src%2FLanguage%2FHaskell%2FLSP%2FTest%2FReplay.hs;h=2e3c514be51124be5b93777bc79e6005353fc654;hb=98d03792f46f3ac870c010a78944822569e76763;hp=7d10763aab553ba19c0239df863fdafae057d9c3;hpb=bd2ac7da01645dc111a6912be661bc13b7f9340f;p=lsp-test.git

diff --git a/src/Language/Haskell/LSP/Test/Replay.hs b/src/Language/Haskell/LSP/Test/Replay.hs
index 7d10763..2e3c514 100644
--- a/src/Language/Haskell/LSP/Test/Replay.hs
+++ b/src/Language/Haskell/LSP/Test/Replay.hs
@@ -10,10 +10,8 @@ import           Control.Concurrent
 import           Control.Monad.IO.Class
 import qualified Data.ByteString.Lazy.Char8    as B
 import qualified Data.Text                     as T
-import           Language.Haskell.LSP.Capture
-import           Language.Haskell.LSP.Messages
 import           Language.Haskell.LSP.Types
-import           Language.Haskell.LSP.Types.Lens as LSP hiding (error)
+import           Language.Haskell.LSP.Types.Lens as LSP
 import           Data.Aeson
 import           Data.Default
 import           Data.List
@@ -23,6 +21,7 @@ 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
@@ -33,6 +32,8 @@ import           Language.Haskell.LSP.Test.Session
 -- makes sure it matches up with an expected response.
 -- The session directory should have a captured session file in it
 -- named "session.log".
+-- You can get these capture files from 'Language.Haskell.LSP.resCaptureFile' in
+-- haskell-lsp.
 replaySession :: String -- ^ The command to run the server.
               -> FilePath -- ^ The recorded session directory.
               -> IO ()
@@ -43,8 +44,9 @@ replaySession serverExe sessionDir = do
   -- 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
@@ -59,13 +61,12 @@ replaySession serverExe sessionDir = do
     mainThread <- myThreadId
 
     sessionThread <- liftIO $ forkIO $
-      runSessionWithHandles serverIn
-                            serverOut
+      runSessionWithHandles serverIn serverOut serverProc
                             (listenServer serverMsgs requestMap reqSema rspSema passSema mainThread)
                             def
                             fullCaps
                             sessionDir
-                            exitServer
+                            (return ()) -- No finalizer cleanup
                             (sendMessages clientMsgs reqSema rspSema)
     takeMVar passSema
     killThread sessionThread
@@ -107,7 +108,7 @@ sendMessages (nextMsg:remainingMsgs) reqSema rspSema =
 
     sendMessages remainingMsgs reqSema rspSema
 
-  response msg@(ResponseMessage _ id _ _) = do
+  response msg@(ResponseMessage _ id _) = do
     liftIO $ putStrLn $ "Waiting for request id " ++ show id ++ " from the server"
     reqId <- liftIO $ takeMVar reqSema
     if responseId reqId /= id
@@ -219,9 +220,9 @@ swapCommands pid (FromClient t (ReqExecuteCommand req):xs) =  FromClient t (ReqE
 
 swapCommands pid (FromServer t (RspInitialize rsp):xs) = FromServer t (RspInitialize swapped):swapCommands pid xs
   where swapped = case newCommands of
-          Just cmds -> result . _Just . LSP.capabilities . executeCommandProvider . _Just . commands .~ cmds $ rsp
+          Just cmds -> result . _Right . LSP.capabilities . executeCommandProvider . _Just . commands .~ cmds $ rsp
           Nothing -> rsp
-        oldCommands = rsp ^? result . _Just . LSP.capabilities . executeCommandProvider . _Just . commands
+        oldCommands = rsp ^? result . _Right . LSP.capabilities . executeCommandProvider . _Just . commands
         newCommands = fmap (fmap (swapPid pid)) oldCommands
 
 swapCommands pid (x:xs) = x:swapCommands pid xs