X-Git-Url: http://git.lukelau.me/?p=lsp-test.git;a=blobdiff_plain;f=src%2FLanguage%2FHaskell%2FLSP%2FTest%2FSession.hs;h=f0d410afed37c295a9ebdac061471056f1bb882b;hp=5948ed0a818c1aed1b28cbef5b5f463d1b952ce7;hb=c11f5798ff6f9634e24c6521eb01d03a27e718ac;hpb=1efccbac7aa4e9f93ae716fb92cbae156fabc391 diff --git a/src/Language/Haskell/LSP/Test/Session.hs b/src/Language/Haskell/LSP/Test/Session.hs index 5948ed0..f0d410a 100644 --- a/src/Language/Haskell/LSP/Test/Session.hs +++ b/src/Language/Haskell/LSP/Test/Session.hs @@ -2,6 +2,7 @@ {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE RankNTypes #-} module Language.Haskell.LSP.Test.Session ( Session @@ -30,6 +31,7 @@ import Control.Concurrent hiding (yield) import Control.Exception import Control.Lens hiding (List) import Control.Monad +import Control.Monad.Fail import Control.Monad.IO.Class import Control.Monad.Except import Control.Monad.Trans.Reader (ReaderT, runReaderT) @@ -69,17 +71,23 @@ import System.IO type Session = ParserStateReader FromServerMessage SessionState SessionContext IO +instance MonadFail Session where + fail s = do + lastMsg <- fromJust . lastReceivedMessage <$> get + liftIO $ throw (UnexpectedMessage s lastMsg) + -- | Stuff you can configure for a 'Session'. data SessionConfig = SessionConfig { messageTimeout :: Int -- ^ Maximum time to wait for a message in seconds, defaults to 60. , logStdErr :: Bool -- ^ Redirect the server's stderr to this stdout, defaults to False. , logMessages :: Bool -- ^ Trace the messages sent and received to stdout, defaults to True. , logColor :: Bool -- ^ Add ANSI color to the logged messages, defaults to True. + , lspConfig :: Maybe Value -- ^ The initial LSP config as JSON value, defaults to Nothing. } -- | The configuration used in 'Language.Haskell.LSP.Test.runSession'. defaultConfig :: SessionConfig -defaultConfig = SessionConfig 60 False False True +defaultConfig = SessionConfig 60 False True True Nothing instance Default SessionConfig where def = defaultConfig