, (<|>)
, satisfy
-- * Utilities
+ , getInitializeResponse
, openDoc
, getDocItem
, getDocUri
import Language.Haskell.LSP.Test.Parsing
-- | Starts a new session.
-runSession :: FilePath -- ^ The filepath to the server executable.
+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 ()
+ -> IO a
runSession serverExe rootDir session = do
pid <- getProcessID
absRootDir <- canonicalizePath rootDir
-- 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
-- Run the actual test
- session
+ result <- session
sendNotification Exit ExitParams
+ return result
+
-- | 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
+ -> String
-> FilePath
-> Session a
-> IO a
runSessionWithHandler serverHandler serverExe rootDir session = do
absRootDir <- canonicalizePath rootDir
- (Just serverIn, Just serverOut, Nothing, serverProc) <- createProcess
- (proc serverExe ["--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
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)
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