+{-# LANGUAGE CPP #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE RankNTypes #-}
module Language.Haskell.LSP.Test.Session
( Session
import Control.Monad
import Control.Monad.IO.Class
import Control.Monad.Except
+#if __GLASGOW_HASKELL__ >= 806
+import Control.Monad.Fail
+#endif
import Control.Monad.Trans.Reader (ReaderT, runReaderT)
import qualified Control.Monad.Trans.Reader as Reader (ask)
import Control.Monad.Trans.State (StateT, runStateT)
import Data.Function
import Language.Haskell.LSP.Messages
import Language.Haskell.LSP.Types.Capabilities
-import Language.Haskell.LSP.Types hiding (error)
+import Language.Haskell.LSP.Types
+import Language.Haskell.LSP.Types.Lens hiding (error)
import Language.Haskell.LSP.VFS
import Language.Haskell.LSP.Test.Decoding
import Language.Haskell.LSP.Test.Exceptions
-- You can send and receive messages to the server within 'Session' via 'getMessage',
-- 'sendRequest' and 'sendNotification'.
--
--- @
--- runSession \"path\/to\/root\/dir\" $ do
--- docItem <- getDocItem "Desktop/simple.hs" "haskell"
--- sendNotification TextDocumentDidOpen (DidOpenTextDocumentParams docItem)
--- diagnostics <- getMessage :: Session PublishDiagnosticsNotification
--- @
+
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 True.
+ , 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 True True
+defaultConfig = SessionConfig 60 False False True Nothing
instance Default SessionConfig where
def = defaultConfig
let context = SessionContext serverIn absRootDir messageChan reqMap initRsp config caps
initState = SessionState (IdInt 0) mempty mempty 0 False Nothing
-
- threadId <- forkIO $ void $ serverHandler serverOut context
- (result, _) <- runSession context initState session
-
- killThread threadId
+ launchServerHandler = forkIO $ void $ serverHandler serverOut context
+ (result, _) <- bracket launchServerHandler killThread $
+ const $ runSession context initState session
return result