src/Language/Haskell/LSP/Test/Parsing.hs

   1 {-# LANGUAGE OverloadedStrings #-}
   2 {-# LANGUAGE MultiParamTypeClasses #-}
   3 {-# LANGUAGE FlexibleInstances #-}
   4 module Language.Haskell.LSP.Test.Parsing where
   5
   6 import Control.Monad.IO.Class
   7 import Control.Monad.Trans.Reader
   8 import qualified Data.ByteString.Lazy.Char8 as B
   9 import Language.Haskell.LSP.Messages
  10 import Language.Haskell.LSP.Types
  11 import Language.Haskell.LSP.Test.Messages
  12 import Language.Haskell.LSP.Test.Decoding
  13 import System.IO
  14 import Control.Concurrent
  15 import Text.Parsec hiding (satisfy)
  16
  17 data MessageParserState = MessageParserState
  18
  19 data SessionContext = SessionContext
  20   {
  21     serverIn :: Handle,
  22     rootDir :: FilePath,
  23     messageChan :: Chan FromServerMessage,
  24     requestMap :: MVar RequestMap
  25   }
  26
  27 newtype SessionState = SessionState
  28   {
  29     curReqId :: LspId
  30   }
  31
  32 type Session = ParsecT (Chan FromServerMessage) SessionState (ReaderT SessionContext IO)
  33
  34 notification :: Session FromServerMessage
  35 notification = satisfy isServerNotification
  36
  37 request :: Session FromServerMessage
  38 request = satisfy isServerRequest
  39
  40 response :: Session FromServerMessage
  41 response = satisfy isServerResponse
  42
  43 loggingNotification :: Session FromServerMessage
  44 loggingNotification = satisfy shouldSkip
  45   where
  46     shouldSkip (NotLogMessage _) = True
  47     shouldSkip (NotShowMessage _) = True
  48     shouldSkip (ReqShowMessage _) = True
  49     shouldSkip _ = False
  50
  51 satisfy :: (Stream s m a, Eq a, Show a) => (a -> Bool) -> ParsecT s u m a
  52 satisfy pred = tokenPrim show nextPos test
  53   where nextPos x _ _ = x
  54         test x = if pred x then Just x else Nothing
  55
  56 testLog = NotLogMessage (NotificationMessage "2.0" WindowLogMessage (LogMessageParams MtLog "Hello world"))
  57
  58 testSymbols = RspDocumentSymbols (ResponseMessage "2.0" (IdRspInt 0) (Just (List [])) Nothing)
  59
  60 instance (MonadIO m) => Stream (Chan a) m a where
  61   uncons c = do
  62     x <- liftIO $ readChan c
  63     return $ Just (x, c)