Start work on matching expected results
authorLuke Lau <luke_lau@icloud.com>
Sat, 19 May 2018 04:22:19 +0000 (00:22 -0400)
committerLuke Lau <luke_lau@icloud.com>
Sat, 19 May 2018 04:22:19 +0000 (00:22 -0400)
example/Recorded.hs
src/Language/Haskell/LSP/Test/Recorded.hs

index dc4aa69fd32f739a82be4e599b72423e657be397..e267ff80ee9f9a1d76f45bb7f7953804c2cd1223 100644 (file)
@@ -3,5 +3,5 @@ import           System.Directory
 import           System.Environment
 
 main = do
-  file <- (head <$> getArgs) >>= canonicalizePath
-  replay file
+  [client, server] <- ((take 2) <$> getArgs) >>= mapM canonicalizePath
+  replay client server
index 10aebe3ac85e71d40587df71094ce85180631658..6bf23198ead14d93b718f61f326107dffa81cc9b 100644 (file)
@@ -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