X-Git-Url: http://git.lukelau.me/?p=lsp-test.git;a=blobdiff_plain;f=src%2FLanguage%2FHaskell%2FLSP%2FTest%2FRecorded.hs;fp=src%2FLanguage%2FHaskell%2FLSP%2FTest%2FRecorded.hs;h=6bf23198ead14d93b718f61f326107dffa81cc9b;hp=10aebe3ac85e71d40587df71094ce85180631658;hb=311e9ea018ce1721cd79341243b79afdda85e2f1;hpb=9db776483f617de170b6798d5ea8a9f997c0d098

diff --git a/src/Language/Haskell/LSP/Test/Recorded.hs b/src/Language/Haskell/LSP/Test/Recorded.hs
index 10aebe3..6bf2319 100644
--- a/src/Language/Haskell/LSP/Test/Recorded.hs
+++ b/src/Language/Haskell/LSP/Test/Recorded.hs
@@ -15,8 +15,12 @@ import           Data.Aeson
 import           System.IO
 import           System.Process
 
-replay :: FilePath -> IO Int
-replay fp = do
+-- | Replays a recorded client output and 
+-- makes sure it matches up with an expected response.
+replay :: FilePath -- ^ The client output to replay to the server.
+       -> FilePath -- ^ The expected response from the server.
+       -> IO Int
+replay cfp sfp = do
 
   (Just serverIn, Just serverOut, _, _) <- createProcess
     (proc "hie" ["--lsp", "-l", "/tmp/hie.log", "-d"]) { std_in  = CreatePipe
@@ -29,21 +33,24 @@ replay fp = do
   -- whether to send the next request
   semaphore <- newEmptyMVar
 
+  -- the recorded client input to the server
+  clientRecIn <- openFile cfp ReadMode
+  serverRecIn <- openFile sfp ReadMode
+  null        <- openFile "/dev/null" WriteMode
+
   -- listen to server
   forkIO $ forever $ do
-    headers <- getHeaders serverOut
-    case read . init <$> lookup "Content-Length" headers of
-      Nothing   -> error "Couldn't read Content-Length header"
-      Just size -> do
-        message <- B.hGet serverOut size
-        case decode message :: Maybe (LSP.ResponseMessage Value) of
+    msg <- getNextMessage serverOut
+    expectedMsg <- getNextMessage serverRecIn
+    putStrLn $ "received: " ++ (show msg)
+    putStrLn $ "next expected: " ++ (show expectedMsg)
+    case decode msg :: Maybe (LSP.RequestMessage Value Value Value) of
+      Just _ -> putStrLn "ignoring request" >> return ()
+      Nothing -> when (msg /= expectedMsg) $ error ("Expected " ++ show expectedMsg ++ " but got " ++ show msg) 
+    case decode msg :: Maybe (LSP.ResponseMessage Value) of
       Just _  -> putMVar semaphore ()
       Nothing -> return () -- might be a notification or something, that's ok
 
-  -- the recorded client input to the server
-  clientRecIn <- openFile fp ReadMode
-  null        <- openFile "/dev/null" WriteMode
-
   -- send inialize request ourselves since haskell-lsp consumes it
   -- rest are handled via `handlers`
   sendInitialize clientRecIn serverIn
@@ -57,15 +64,20 @@ replay fp = do
                          Nothing
  where
   sendInitialize recH serverH = do
-    headers <- getHeaders recH
-    case read . init <$> lookup "Content-Length" headers of
-      Nothing   -> error "Failed to read the read the initialize request"
-      Just size -> do
-        message <- B.hGet recH size
+    message <- getNextMessage recH
     B.hPut serverH (addHeader message)
     -- bring the file back to the start for haskell-lsp
     hSeek recH AbsoluteSeek 0
 
+-- | Fetches the next message bytes based on
+-- the Content-Length header
+getNextMessage :: Handle -> IO B.ByteString
+getNextMessage h = do
+  headers <- getHeaders h
+  case read . init <$> lookup "Content-Length" headers of
+    Nothing   -> error "Couldn't read Content-Length header"
+    Just size -> B.hGet h size
+
 
 handlers :: Handle -> MVar () -> Handlers
 handlers serverH flag = def