X-Git-Url: http://git.lukelau.me/?a=blobdiff_plain;f=src%2FLanguage%2FHaskell%2FLSP%2FTest.hs;h=8da0cbbee8ba065533e8e0d06ac79e3f35ee4612;hb=f3a1c846d97e7d081375501835695334ddd3b34f;hp=fb928a4b9ccd0bfbec75cd4bae66af408e885242;hpb=ac2553b38ed2228839cb72747f8c48b7c2fab488;p=lsp-test.git diff --git a/src/Language/Haskell/LSP/Test.hs b/src/Language/Haskell/LSP/Test.hs index fb928a4..8da0cbb 100644 --- a/src/Language/Haskell/LSP/Test.hs +++ b/src/Language/Haskell/LSP/Test.hs @@ -54,6 +54,7 @@ module Language.Haskell.LSP.Test , (<|>) , satisfy -- * Utilities + , getInitializeResponse , openDoc , getDocItem , getDocUri @@ -81,10 +82,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 :: String -- ^ The command to run the server. + -> 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 @@ -95,12 +97,17 @@ 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 Initialize initializeParams - initRsp <- response :: Session InitializeResponse - liftIO $ maybe (return ()) (putStrLn . ("Error while initializing: " ++) . show ) (initRsp ^. LSP.error) + initRspMsg <- response :: Session InitializeResponse + + liftIO $ maybe (return ()) (putStrLn . ("Error while initializing: " ++) . show ) (initRspMsg ^. LSP.error) + + initRspVar <- initRsp <$> ask + liftIO $ putMVar initRspVar initRspMsg + sendNotification Initialized InitializedParams @@ -112,15 +119,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 ()) + -> String -> 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"]) - { std_in = CreatePipe, std_out = CreatePipe } + let createProc = (shell serverExe) { std_in = CreatePipe, std_out = CreatePipe, std_err = CreatePipe } + (Just serverIn, Just serverOut, _, serverProc) <- createProcess createProc hSetBuffering serverIn NoBuffering hSetBuffering serverOut NoBuffering @@ -128,8 +135,9 @@ runSessionWithHandler serverHandler rootDir session = do reqMap <- newMVar newRequestMap messageChan <- newChan meaninglessChan <- newChan + initRsp <- newEmptyMVar - let context = SessionContext serverIn absRootDir messageChan reqMap + let context = SessionContext serverIn absRootDir messageChan reqMap initRsp initState = SessionState (IdInt 9) threadId <- forkIO $ void $ runSession' meaninglessChan context initState (serverHandler serverOut) @@ -223,6 +231,12 @@ sendMessage msg = do h <- serverIn <$> ask liftIO $ B.hPut h $ addHeader (encode msg) +-- | Returns the initialize response that was received from the server. +-- The initialize requests and responses are not included the session, +-- so if you need to test it use this. +getInitializeResponse :: Session InitializeResponse +getInitializeResponse = initRsp <$> ask >>= (liftIO . readMVar) + -- | Opens a text document and sends a notification to the client. openDoc :: FilePath -> String -> Session TextDocumentIdentifier openDoc file languageId = do