1 module Language.Haskell.LSP.Test.Session where
3 import Control.Concurrent
5 import Control.Monad.Trans.Class
6 import Control.Monad.Trans.Reader
7 import Control.Monad.Trans.State
9 import Data.Conduit.Parser
10 import Language.Haskell.LSP.Messages
11 import Language.Haskell.LSP.Types
12 import Language.Haskell.LSP.VFS
13 import Language.Haskell.LSP.Test.Compat
14 import Language.Haskell.LSP.Test.Decoding
15 import System.Directory
18 data SessionContext = SessionContext
22 , messageChan :: Chan FromServerMessage
23 , requestMap :: MVar RequestMap
24 , initRsp :: MVar InitializeResponse
27 data SessionState = SessionState
33 type ParserStateReader a s r m = ConduitParser a (StateT s (ReaderT r m))
35 -- | A session representing one instance of launching and connecting to a server.
37 -- You can send and receive messages to the server within 'Session' via 'getMessage',
38 -- 'sendRequest' and 'sendNotification'.
41 -- runSession \"path\/to\/root\/dir\" $ do
42 -- docItem <- getDocItem "Desktop/simple.hs" "haskell"
43 -- sendNotification TextDocumentDidOpen (DidOpenTextDocumentParams docItem)
44 -- diagnostics <- getMessage :: Session PublishDiagnosticsNotification
46 type Session = ParserStateReader FromServerMessage SessionState SessionContext IO
49 runSession' :: Chan FromServerMessage -> SessionContext -> SessionState -> Session a -> IO (a, SessionState)
50 runSession' chan context state session = runReaderT (runStateT conduit state) context
51 where conduit = runConduit $ chanSource chan .| runConduitParser session
53 get :: Monad m => ParserStateReader a s r m s
54 get = lift Control.Monad.Trans.State.get
56 put :: Monad m => s -> ParserStateReader a s r m ()
57 put = lift . Control.Monad.Trans.State.put
59 modify :: Monad m => (s -> s) -> ParserStateReader a s r m ()
60 modify = lift . Control.Monad.Trans.State.modify
62 ask :: Monad m => ParserStateReader a s r m r
63 ask = lift $ lift Control.Monad.Trans.Reader.ask
67 -- | An internal version of 'runSession' that allows for a custom handler to listen to the server.
68 -- It also does not automatically send initialize and exit messages.
69 runSessionWithHandles :: Handle -- ^ Server in
70 -> Handle -- ^ Server out
71 -> (Handle -> Session ()) -- ^ Server listener
75 runSessionWithHandles serverIn serverOut serverHandler rootDir session = do
76 absRootDir <- canonicalizePath rootDir
78 hSetBuffering serverIn NoBuffering
79 hSetBuffering serverOut NoBuffering
81 reqMap <- newMVar newRequestMap
82 messageChan <- newChan
83 meaninglessChan <- newChan
84 initRsp <- newEmptyMVar
86 let context = SessionContext serverIn absRootDir messageChan reqMap initRsp
87 initState = SessionState (IdInt 9) mempty
89 threadId <- forkIO $ void $ runSession' meaninglessChan context initState (serverHandler serverOut)
90 (result, _) <- runSession' messageChan context initState session