1 {-# LANGUAGE OverloadedStrings #-}
2 {-# LANGUAGE MultiParamTypeClasses #-}
3 {-# LANGUAGE FlexibleInstances #-}
4 module Language.Haskell.LSP.Test.Parsing where
6 import Control.Applicative
7 import Control.Monad.Trans.Class
8 import Control.Monad.IO.Class
9 import Control.Monad.Trans.Reader
10 import Control.Monad.Trans.State
11 import Language.Haskell.LSP.Messages
12 import Language.Haskell.LSP.Types
13 import Language.Haskell.LSP.Test.Messages
14 import Language.Haskell.LSP.Test.Decoding
16 import Control.Concurrent.Chan
17 import Control.Concurrent.MVar
18 import Data.Conduit hiding (await)
19 import Data.Conduit.Parser
21 data MessageParserState = MessageParserState
23 data SessionContext = SessionContext
27 messageChan :: Chan FromServerMessage,
28 requestMap :: MVar RequestMap
31 newtype SessionState = SessionState
36 type ParserStateReader a s r m = ConduitParser a (StateT s (ReaderT r m))
37 -- | A session representing one instance of launching and connecting to a server.
39 -- You can send and receive messages to the server within 'Session' via 'getMessage',
40 -- 'sendRequest' and 'sendNotification'.
43 -- runSession \"path\/to\/root\/dir\" $ do
44 -- docItem <- getDocItem "Desktop/simple.hs" "haskell"
45 -- sendNotification TextDocumentDidOpen (DidOpenTextDocumentParams docItem)
46 -- diagnostics <- getMessage :: Session PublishDiagnosticsNotification
48 type Session = ParserStateReader FromServerMessage SessionState SessionContext IO
50 -- | Matches if the message is a notification.
51 notification :: Session FromServerMessage
52 notification = satisfy isServerNotification
54 -- | Matches if the message is a request.
55 request :: Session FromServerMessage
56 request = satisfy isServerRequest
58 -- | Matches if the message is a response.
59 response :: Session FromServerMessage
60 response = satisfy isServerResponse
62 -- | Matches if the message is a log message notification or a show message notification/request.
63 loggingNotification :: Session FromServerMessage
64 loggingNotification = satisfy shouldSkip
66 shouldSkip (NotLogMessage _) = True
67 shouldSkip (NotShowMessage _) = True
68 shouldSkip (ReqShowMessage _) = True
71 satisfy :: Monad m => (a -> Bool) -> ConduitParser a m a
78 chanSource:: MonadIO m => Chan o -> ConduitT i o m b
80 x <- liftIO $ readChan c
84 runSession' :: Chan FromServerMessage -> SessionContext -> SessionState -> Session a -> IO (a, SessionState)
85 runSession' chan context state session = runReaderT (runStateT conduit state) context
86 where conduit = runConduit $ chanSource chan .| runConduitParser session
88 get :: Monad m => ParserStateReader a s r m s
89 get = lift Control.Monad.Trans.State.get
91 put :: Monad m => s -> ParserStateReader a s r m ()
92 put = lift . Control.Monad.Trans.State.put
94 modify :: Monad m => (s -> s) -> ParserStateReader a s r m ()
95 modify = lift . Control.Monad.Trans.State.modify
97 ask :: Monad m => ParserStateReader a s r m r
98 ask = lift $ lift Control.Monad.Trans.Reader.ask