Merge branch 'master' of https://github.com/Bubba/lsp-test

[opengl.git] / src / Language / Haskell / LSP / Test / Session.hs

diff --git a/src/Language/Haskell/LSP/Test/Session.hs b/src/Language/Haskell/LSP/Test/Session.hs
index 28d4eddec1591fbbe190fc825abc5c0c1453a0f5..dc3c6ff870cccbb488b490b896b6d7bdab9f58f1 100644 (file)
--- a/src/Language/Haskell/LSP/Test/Session.hs
+++ b/src/Language/Haskell/LSP/Test/Session.hs
@@ -3,6 +3,7 @@
 {-# LANGUAGE FlexibleInstances #-}
 {-# LANGUAGE MultiParamTypeClasses #-}
 {-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE RankNTypes #-}
 
 module Language.Haskell.LSP.Test.Session
   ( Session
@@ -31,6 +32,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
 #if __GLASGOW_HASKELL__ >= 806
@@ -73,17 +75,25 @@ import System.IO
 
 type Session = ParserStateReader FromServerMessage SessionState SessionContext IO
 
+#if __GLASGOW_HASKELL__ >= 806
+instance MonadFail Session where
+  fail s = do
+    lastMsg <- fromJust . lastReceivedMessage <$> get
+    liftIO $ throw (UnexpectedMessage s lastMsg)
+#endif
+
 -- | 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 False.
   , 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
@@ -148,11 +158,6 @@ instance Monad m => HasState SessionState (ConduitM a b (StateT SessionState m))
 
 type ParserStateReader a s r m = ConduitParser a (StateT s (ReaderT r m))
 
-#if __GLASGOW_HASKELL__ >= 806
-instance (Fail.MonadFail m) => Fail.MonadFail (ParserStateReader a s r m) where
-  fail = Fail.fail
-#endif
-
 runSession :: SessionContext -> SessionState -> Session a -> IO (a, SessionState)
 runSession context state session = runReaderT (runStateT conduit state) context
   where