, haskell-lsp
, aeson
, bytestring
- , conduit-parse
, conduit
+ , conduit-parse
, containers
, data-default
, directory
, filepath
, lens
- , parsers
+ , parser-combinators
, process
, text
, transformers
, directory
, haskell-lsp-test
, haskell-lsp
+ , conduit
+ , conduit-parse
+ other-modules: ParsingTests
default-language: Haskell2010
executable example
, choice
, option
, optional
- , skipOptional
, between
, some
, many
, sepBy
, sepBy1
- , sepByNonEmpty
, sepEndBy1
- , sepEndByNonEmpty
, sepEndBy
, endBy1
- , endByNonEmpty
, endBy
, count
- , chainl
- , chainr
- , chainl1
- , chainr1
, manyTill
- , try
- , (<?>)
, skipMany
, skipSome
- , unexpected
- , notFollowedBy
+ , skipManyTill
+ , skipSomeTill
, (<|>)
, satisfy
-- * Utilities
) where
import Control.Applicative
+import Control.Applicative.Combinators
import Control.Monad
import Control.Monad.IO.Class
import Control.Concurrent
import System.FilePath
import Language.Haskell.LSP.Test.Decoding
import Language.Haskell.LSP.Test.Parsing
-import Text.Parser.Combinators
-- | Starts a new session.
runSession :: FilePath -- ^ The filepath to the root directory for the session.
}
type ParserStateReader a s r m = ConduitParser a (StateT s (ReaderT r m))
+
-- | A session representing one instance of launching and connecting to a server.
--
-- You can send and receive messages to the server within 'Session' via 'getMessage',
type Session = ParserStateReader FromServerMessage SessionState SessionContext IO
-- | Matches if the message is a notification.
-notification :: Session FromServerMessage
+notification :: Monad m => ConduitParser FromServerMessage m FromServerMessage
notification = satisfy isServerNotification
-- | Matches if the message is a request.
-request :: Session FromServerMessage
+request :: Monad m => ConduitParser FromServerMessage m FromServerMessage
request = satisfy isServerRequest
-- | Matches if the message is a response.
-response :: Session FromServerMessage
+response :: Monad m => ConduitParser FromServerMessage m FromServerMessage
response = satisfy isServerResponse
-- | Matches if the message is a log message notification or a show message notification/request.
-loggingNotification :: Session FromServerMessage
+loggingNotification :: Monad m => ConduitParser FromServerMessage m FromServerMessage
loggingNotification = satisfy shouldSkip
where
shouldSkip (NotLogMessage _) = True
shouldSkip (ReqShowMessage _) = True
shouldSkip _ = False
-publishDiagnosticsNotification :: Session PublishDiagnosticsNotification
+publishDiagnosticsNotification :: Monad m => ConduitParser FromServerMessage m PublishDiagnosticsNotification
publishDiagnosticsNotification = do
- (NotPublishDiagnostics diags) <- satisfy test
+ NotPublishDiagnostics diags <- satisfy test
return diags
- where test (NotPublishDiagnostics _) = False
+ where test (NotPublishDiagnostics _) = True
test _ = False
satisfy :: Monad m => (a -> Bool) -> ConduitParser a m a
--- /dev/null
+{-# LANGUAGE OverloadedStrings #-}
+module ParsingTests where
+
+import Control.Lens hiding (List)
+import Language.Haskell.LSP.Messages
+import Language.Haskell.LSP.Test
+import Language.Haskell.LSP.Types
+import Data.Conduit
+import Data.Conduit.Parser
+import Test.Hspec
+
+parsingSpec :: Spec
+parsingSpec =
+ describe "diagnostics" $ do
+ let testDiag = NotPublishDiagnostics
+ (NotificationMessage "2.0"
+ TextDocumentPublishDiagnostics
+ (PublishDiagnosticsParams (Uri "foo")
+ (List [])))
+ it "get picked up" $ do
+ let
+ source = yield testDiag
+ session = do
+ diags <- publishDiagnosticsNotification
+ return $ diags ^. params . uri
+ runConduit (source .| runConduitParser session) `shouldReturn` Uri "foo"
+ it "get picked up after skipping others before" $ do
+ let testDiag = NotPublishDiagnostics
+ (NotificationMessage "2.0"
+ TextDocumentPublishDiagnostics
+ (PublishDiagnosticsParams (Uri "foo")
+ (List [])))
+ notTestDiag = NotLogMessage (NotificationMessage "2.0" WindowLogMessage (LogMessageParams MtLog "foo"))
+ source = yield notTestDiag >> yield testDiag
+ session = do
+ diags <- skipManyTill notification publishDiagnosticsNotification
+ return $ diags ^. params . uri
+ runConduit (source .| runConduitParser session) `shouldReturn` Uri "foo"
\ No newline at end of file
import Language.Haskell.LSP.Test.Replay
import Language.Haskell.LSP.Types
import Language.Haskell.LSP.Messages
+import ParsingTests
main = hspec $ do
- describe "manual session validation" $
+ describe "manual session validation" $ do
it "passes a test" $
runSession "test/recordings/renamePass" $ do
doc <- openDoc "Desktop/simple.hs" "haskell"
mainSymbol ^. location . range `shouldBe` Range (Position 3 0) (Position 3 4)
mainSymbol ^. containerName `shouldBe` Nothing
+ it "fails a test" $
+ -- TODO: Catch the exception in haskell-lsp-test and provide nicer output
+ let session = runSession "test/recordings/renamePass" $ do
+ openDoc "Desktop/simple.hs" "haskell"
+ skipMany loggingNotification
+ request
+ in session `shouldThrow` anyException
+
describe "replay session" $ do
it "passes a test" $
replaySession "test/recordings/renamePass" `shouldReturn` True
it "fails a test" $
replaySession "test/recordings/renameFail" `shouldReturn` False
+
+ parsingSpec
\ No newline at end of file