1 {-# LANGUAGE MultiParamTypeClasses #-}
2 {-# LANGUAGE FlexibleInstances #-}
3 module Language.Haskell.LSP.Test.Parsing where
5 import Control.Applicative
6 import Control.Monad.Trans.Class
7 import Control.Monad.IO.Class
8 import Control.Monad.Trans.Reader
9 import Control.Monad.Trans.State
10 import Language.Haskell.LSP.Messages
11 import Language.Haskell.LSP.Types hiding (error)
12 import Language.Haskell.LSP.Test.Messages
13 import Language.Haskell.LSP.Test.Decoding
15 import Control.Concurrent.Chan
16 import Control.Concurrent.MVar
17 import Data.Conduit hiding (await)
18 import Data.Conduit.Parser
20 data SessionContext = SessionContext
24 messageChan :: Chan FromServerMessage,
25 requestMap :: MVar RequestMap
28 newtype SessionState = SessionState
33 type ParserStateReader a s r m = ConduitParser a (StateT s (ReaderT r m))
34 -- | A session representing one instance of launching and connecting to a server.
36 -- You can send and receive messages to the server within 'Session' via 'getMessage',
37 -- 'sendRequest' and 'sendNotification'.
40 -- runSession \"path\/to\/root\/dir\" $ do
41 -- docItem <- getDocItem "Desktop/simple.hs" "haskell"
42 -- sendNotification TextDocumentDidOpen (DidOpenTextDocumentParams docItem)
43 -- diagnostics <- getMessage :: Session PublishDiagnosticsNotification
45 type Session = ParserStateReader FromServerMessage SessionState SessionContext IO
47 -- | Matches if the message is a notification.
48 notification :: Session FromServerMessage
49 notification = satisfy isServerNotification
51 -- | Matches if the message is a request.
52 request :: Session FromServerMessage
53 request = satisfy isServerRequest
55 -- | Matches if the message is a response.
56 response :: Session FromServerMessage
57 response = satisfy isServerResponse
59 -- | Matches if the message is a log message notification or a show message notification/request.
60 loggingNotification :: Session FromServerMessage
61 loggingNotification = satisfy shouldSkip
63 shouldSkip (NotLogMessage _) = True
64 shouldSkip (NotShowMessage _) = True
65 shouldSkip (ReqShowMessage _) = True
68 publishDiagnosticsNotification :: Session PublishDiagnosticsNotification
69 publishDiagnosticsNotification = do
70 (NotPublishDiagnostics diags) <- satisfy test
72 where test (NotPublishDiagnostics _) = False
75 satisfy :: Monad m => (a -> Bool) -> ConduitParser a m a
82 chanSource:: MonadIO m => Chan o -> ConduitT i o m b
84 x <- liftIO $ readChan c
88 runSession' :: Chan FromServerMessage -> SessionContext -> SessionState -> Session a -> IO (a, SessionState)
89 runSession' chan context state session = runReaderT (runStateT conduit state) context
90 where conduit = runConduit $ chanSource chan .| runConduitParser session
92 get :: Monad m => ParserStateReader a s r m s
93 get = lift Control.Monad.Trans.State.get
95 put :: Monad m => s -> ParserStateReader a s r m ()
96 put = lift . Control.Monad.Trans.State.put
98 modify :: Monad m => (s -> s) -> ParserStateReader a s r m ()
99 modify = lift . Control.Monad.Trans.State.modify
101 ask :: Monad m => ParserStateReader a s r m r
102 ask = lift $ lift Control.Monad.Trans.Reader.ask