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))
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
48 -- | Matches if the message is a notification.
49 notification :: Monad m => ConduitParser FromServerMessage m FromServerMessage
50 notification = satisfy isServerNotification
52 -- | Matches if the message is a request.
53 request :: Monad m => ConduitParser FromServerMessage m FromServerMessage
54 request = satisfy isServerRequest
56 -- | Matches if the message is a response.
57 response :: Monad m => ConduitParser FromServerMessage m FromServerMessage
58 response = satisfy isServerResponse
60 -- | Matches if the message is a log message notification or a show message notification/request.
61 loggingNotification :: Monad m => ConduitParser FromServerMessage m FromServerMessage
62 loggingNotification = satisfy shouldSkip
64 shouldSkip (NotLogMessage _) = True
65 shouldSkip (NotShowMessage _) = True
66 shouldSkip (ReqShowMessage _) = True
69 publishDiagnosticsNotification :: Monad m => ConduitParser FromServerMessage m PublishDiagnosticsNotification
70 publishDiagnosticsNotification = do
71 NotPublishDiagnostics diags <- satisfy test
73 where test (NotPublishDiagnostics _) = True
76 satisfy :: Monad m => (a -> Bool) -> ConduitParser a m a
83 chanSource :: MonadIO m => Chan o -> ConduitT i o m b
85 x <- liftIO $ readChan c
89 runSession' :: Chan FromServerMessage -> SessionContext -> SessionState -> Session a -> IO (a, SessionState)
90 runSession' chan context state session = runReaderT (runStateT conduit state) context
91 where conduit = runConduit $ chanSource chan .| runConduitParser session
93 get :: Monad m => ParserStateReader a s r m s
94 get = lift Control.Monad.Trans.State.get
96 put :: Monad m => s -> ParserStateReader a s r m ()
97 put = lift . Control.Monad.Trans.State.put
99 modify :: Monad m => (s -> s) -> ParserStateReader a s r m ()
100 modify = lift . Control.Monad.Trans.State.modify
102 ask :: Monad m => ParserStateReader a s r m r
103 ask = lift $ lift Control.Monad.Trans.Reader.ask