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 Language.Haskell.LSP.Messages
   7 import Language.Haskell.LSP.Types
   8 import Language.Haskell.LSP.Test.Messages
   9 import Control.Concurrent
  10 import Text.Parsec hiding (satisfy)
  11 import Control.Monad
  12
  13 data MessageParserState = MessageParserState
  14
  15 type MessageParser = ParsecT (Chan FromServerMessage) MessageParserState IO
  16
  17 notification :: MessageParser FromServerMessage
  18 notification = satisfy isServerNotification
  19
  20 request :: MessageParser FromServerMessage
  21 request = satisfy isServerRequest
  22
  23 response :: MessageParser FromServerMessage
  24 response = satisfy isServerResponse
  25
  26 satisfy :: (Stream s m a, Eq a, Show a) => (a -> Bool) -> ParsecT s u m a
  27 satisfy pred = tokenPrim show nextPos test
  28   where nextPos x _ _ = x
  29         test x = if pred x then Just x else Nothing
  30
  31 testLog = NotLogMessage (NotificationMessage "2.0" WindowLogMessage (LogMessageParams MtLog "Hello world"))
  32
  33 testSymbols = RspDocumentSymbols (ResponseMessage "2.0" (IdRspInt 0) (Just (List [])) Nothing)
  34
  35 instance Stream (Chan a) IO a where
  36   uncons c = do
  37     x <- readChan c
  38     return $ Just (x, c)
  39
  40 test :: IO ()
  41 test = do
  42   chan <- newChan
  43   let parser = do
  44         n <- count 2 notification
  45         rsp <- response
  46         return (n, rsp)
  47   forkIO $ forM_ [testLog, testLog, testSymbols] $ \x -> do
  48     writeChan chan x
  49     threadDelay 1000000
  50   x <- runParserT parser MessageParserState "" chan
  51   print x