From 4eb97ef8a3d4b3908fa9b5bbbd5ae77cfa95cecc Mon Sep 17 00:00:00 2001 From: Luke Lau Date: Mon, 11 Jun 2018 10:27:27 -0400 Subject: [PATCH] Add argument for server executable --- example/Main.hs | 2 +- src/Language/Haskell/LSP/Test.hs | 12 +++++++----- src/Language/Haskell/LSP/Test/Replay.hs | 7 ++++--- test/Test.hs | 8 ++++---- 4 files changed, 16 insertions(+), 13 deletions(-) diff --git a/example/Main.hs b/example/Main.hs index d66e17e..0c8ae9f 100644 --- a/example/Main.hs +++ b/example/Main.hs @@ -4,7 +4,7 @@ import Data.Proxy import Control.Monad.IO.Class -main = runSession "test/recordings/renamePass" $ do +main = runSession "hie" "test/recordings/renamePass" $ do docItem <- getDocItem "Desktop/simple.hs" "haskell" docId <- TextDocumentIdentifier <$> getDocUri "Desktop/simple.hs" diff --git a/src/Language/Haskell/LSP/Test.hs b/src/Language/Haskell/LSP/Test.hs index 2e0926a..087143f 100644 --- a/src/Language/Haskell/LSP/Test.hs +++ b/src/Language/Haskell/LSP/Test.hs @@ -80,10 +80,11 @@ import Language.Haskell.LSP.Test.Decoding import Language.Haskell.LSP.Test.Parsing -- | Starts a new session. -runSession :: FilePath -- ^ The filepath to the root directory for the session. +runSession :: FilePath -- ^ The filepath to the server executable. + -> FilePath -- ^ The filepath to the root directory for the session. -> Session a -- ^ The session to run. -> IO () -runSession rootDir session = do +runSession serverExe rootDir session = do pid <- getProcessID absRootDir <- canonicalizePath rootDir @@ -94,7 +95,7 @@ runSession rootDir session = do def (Just TraceOff) - runSessionWithHandler listenServer rootDir $ do + runSessionWithHandler listenServer serverExe rootDir $ do -- Wrap the session around initialize and shutdown calls sendRequest (Proxy :: Proxy InitializeRequest) Initialize initializeParams @@ -111,14 +112,15 @@ runSession rootDir session = do -- | An internal version of 'runSession' that allows for a custom handler to listen to the server. -- It also does not automatically send initialize and exit messages. runSessionWithHandler :: (Handle -> Session ()) + -> FilePath -> FilePath -> Session a -> IO a -runSessionWithHandler serverHandler rootDir session = do +runSessionWithHandler serverHandler serverExe rootDir session = do absRootDir <- canonicalizePath rootDir (Just serverIn, Just serverOut, Nothing, serverProc) <- createProcess - (proc "hie" ["--lsp", "-d", "-l", "/tmp/hie-test.log"]) + (proc serverExe ["--lsp", "-d", "-l", "/tmp/hie-test.log"]) { std_in = CreatePipe, std_out = CreatePipe } hSetBuffering serverIn NoBuffering diff --git a/src/Language/Haskell/LSP/Test/Replay.hs b/src/Language/Haskell/LSP/Test/Replay.hs index 2b55382..4802c9a 100644 --- a/src/Language/Haskell/LSP/Test/Replay.hs +++ b/src/Language/Haskell/LSP/Test/Replay.hs @@ -29,9 +29,10 @@ import Language.Haskell.LSP.Test.Messages -- makes sure it matches up with an expected response. -- The session directory should have a captured session file in it -- named "session.log". -replaySession :: FilePath -- ^ The recorded session directory. +replaySession :: FilePath -- ^ The filepath to the server executable. + -> FilePath -- ^ The recorded session directory. -> IO Bool -replaySession sessionDir = do +replaySession serverExe sessionDir = do entries <- B.lines <$> B.readFile (sessionDir "session.log") @@ -50,7 +51,7 @@ replaySession sessionDir = do rspSema <- newEmptyMVar passVar <- newEmptyMVar :: IO (MVar Bool) - forkIO $ runSessionWithHandler (listenServer serverMsgs requestMap reqSema rspSema passVar) sessionDir $ + forkIO $ runSessionWithHandler (listenServer serverMsgs requestMap reqSema rspSema passVar) serverExe sessionDir $ sendMessages clientMsgs reqSema rspSema takeMVar passVar diff --git a/test/Test.hs b/test/Test.hs index 652485e..c7e6713 100644 --- a/test/Test.hs +++ b/test/Test.hs @@ -14,7 +14,7 @@ import ParsingTests main = hspec $ do describe "manual session validation" $ do it "passes a test" $ - runSession "test/recordings/renamePass" $ do + runSession "hie" "test/recordings/renamePass" $ do doc <- openDoc "Desktop/simple.hs" "haskell" skipMany loggingNotification @@ -39,7 +39,7 @@ main = hspec $ do it "fails a test" $ -- TODO: Catch the exception in haskell-lsp-test and provide nicer output - let session = runSession "test/recordings/renamePass" $ do + let session = runSession "hie" "test/recordings/renamePass" $ do openDoc "Desktop/simple.hs" "haskell" skipMany loggingNotification request @@ -47,8 +47,8 @@ main = hspec $ do describe "replay session" $ do it "passes a test" $ - replaySession "test/recordings/renamePass" `shouldReturn` True + replaySession "hie" "test/recordings/renamePass" `shouldReturn` True it "fails a test" $ - replaySession "test/recordings/renameFail" `shouldReturn` False + replaySession "hie" "test/recordings/renameFail" `shouldReturn` False parsingSpec -- 2.30.2