X-Git-Url: http://git.lukelau.me/?p=lsp-test.git;a=blobdiff_plain;f=src%2FLanguage%2FHaskell%2FLSP%2FTest%2FReplay.hs;h=7def859a2e9bda826d40d10602bad9f6a9897afc;hp=9d7f136a20056a7f81359e23f9856c0248c915de;hb=5170a20560a68b8fcaed83ecaf6146d84a147992;hpb=bf93e74482200ee189ca0be09970b9a34bb1511c

diff --git a/src/Language/Haskell/LSP/Test/Replay.hs b/src/Language/Haskell/LSP/Test/Replay.hs
index 9d7f136..7def859 100644
--- a/src/Language/Haskell/LSP/Test/Replay.hs
+++ b/src/Language/Haskell/LSP/Test/Replay.hs
@@ -7,22 +7,27 @@ where
 
 import           Prelude hiding (id)
 import           Control.Concurrent
+import           Control.Exception
 import           Control.Monad.IO.Class
 import qualified Data.ByteString.Lazy.Char8    as B
+import qualified Data.Text                     as T
+import           Data.UUID
 import           Language.Haskell.LSP.Capture
 import           Language.Haskell.LSP.Messages
 import           Language.Haskell.LSP.Types hiding (error)
 import           Data.Aeson
 import           Data.List
 import           Data.Maybe
-import           Control.Lens
+import           Control.Lens hiding (List)
 import           Control.Monad
 import           System.IO
 import           System.FilePath
+import           System.Random
 import           Language.Haskell.LSP.Test
 import           Language.Haskell.LSP.Test.Files
 import           Language.Haskell.LSP.Test.Decoding
 import           Language.Haskell.LSP.Test.Messages
+import           Language.Haskell.LSP.Test.Server
 
 
 -- | Replays a captured client output and 
@@ -39,7 +44,9 @@ replaySession serverExe sessionDir = do
   -- decode session
   let unswappedEvents = map (fromJust . decode) entries
 
-  events <- swapFiles sessionDir unswappedEvents
+  withServer serverExe $ \serverIn serverOut pid -> do
+
+    events <- swapUUIDs pid <$> swapFiles sessionDir unswappedEvents
 
     let clientEvents = filter isClientMsg events
         serverEvents = filter isServerMsg events
@@ -52,8 +59,9 @@ replaySession serverExe sessionDir = do
     passVar <- newEmptyMVar :: IO (MVar Bool)
 
     threadId <- forkIO $
-    runSessionWithHandler (listenServer serverMsgs requestMap reqSema rspSema passVar)
-                          serverExe
+      runSessionWithHandles serverIn
+                            serverOut
+                            (listenServer serverMsgs requestMap reqSema rspSema passVar)
                             sessionDir
                             (sendMessages clientMsgs reqSema rspSema)
 
@@ -120,7 +128,11 @@ isNotification _                              = False
 listenServer :: [FromServerMessage] -> RequestMap -> MVar LspId -> MVar LspIdRsp -> MVar Bool -> Handle -> Session ()
 listenServer [] _ _ _ passVar _ = liftIO $ putMVar passVar True
 listenServer expectedMsgs reqMap reqSema rspSema passVar serverOut  = do
-  msgBytes <- liftIO $ getNextMessage serverOut
+
+  let handler :: IOException -> IO B.ByteString
+      handler _ = putMVar passVar False >> return B.empty
+
+  msgBytes <- liftIO $ catch (getNextMessage serverOut) handler
   let msg = decodeFromServerMsg reqMap msgBytes
 
   handleServerMessage request response notification msg
@@ -186,3 +198,19 @@ shouldSkip (NotLogMessage  _) = True
 shouldSkip (NotShowMessage _) = True
 shouldSkip (ReqShowMessage _) = True
 shouldSkip _                  = False
+
+-- | Swaps out the expected UUIDs to match the current process ID
+swapUUIDs :: Int -> [Event] -> [Event]
+swapUUIDs _ [] = []
+swapUUIDs pid (FromServer t (RspInitialize rsp):xs) = FromServer t (RspInitialize swapped):swapUUIDs pid xs
+  where swapped = case newCommands of
+          Just cmds -> result . _Just . capabilities . executeCommandProvider . _Just . commands .~ cmds $ rsp
+          Nothing -> rsp
+        oldCommands = rsp ^? result . _Just . capabilities . executeCommandProvider . _Just . commands
+        newCommands = fmap (fmap swap) oldCommands
+        swap cmd
+          | isUuid cmd = T.append uuid $ T.dropWhile (/= ':') cmd
+          | otherwise = cmd
+        uuid = toText $ fst $ random $ mkStdGen pid
+        isUuid = isJust . fromText . T.takeWhile (/= ':')
+swapUUIDs pid (x:xs) = x:swapUUIDs pid xs
\ No newline at end of file