From: Luke Lau <luke_lau@icloud.com>
Date: Wed, 2 Sep 2020 12:00:41 +0000 (+0100)
Subject: Add initialWorkspaceFolders config option
X-Git-Tag: 0.13.0.0~7^2~14
X-Git-Url: https://git.lukelau.me/?p=lsp-test.git;a=commitdiff_plain;h=396083e05601ec9ce9f654f18054471634f7efa0

Add initialWorkspaceFolders config option
---

diff --git a/src/Language/Haskell/LSP/Test.hs b/src/Language/Haskell/LSP/Test.hs
index 7f13a44..2f99b19 100644
--- a/src/Language/Haskell/LSP/Test.hs
+++ b/src/Language/Haskell/LSP/Test.hs
@@ -197,7 +197,7 @@ runSessionWithHandles' serverProc serverIn serverOut config' caps rootDir sessio
                                           Nothing
                                           caps
                                           (Just TraceOff)
-                                          Nothing
+                                          (List <$> initialWorkspaceFolders config)
   runSession' serverIn serverOut serverProc listenServer config caps rootDir exitServer $ do
     -- Wrap the session around initialize and shutdown calls
     -- initRspMsg <- sendRequest Initialize initializeParams :: Session InitializeResponse
diff --git a/src/Language/Haskell/LSP/Test/Session.hs b/src/Language/Haskell/LSP/Test/Session.hs
index f9444f6..a6474bb 100644
--- a/src/Language/Haskell/LSP/Test/Session.hs
+++ b/src/Language/Haskell/LSP/Test/Session.hs
@@ -110,11 +110,14 @@ data SessionConfig = SessionConfig
   -- 'Language.Haskell.LSP.Types.LogMessageNotification', defaults to False.
   --
   -- @since 0.9.0.0
+  , initialWorkspaceFolders :: Maybe [WorkspaceFolder]
+  -- ^ The initial workspace folders to send in the @initialize@ request.
+  -- Defaults to Nothing.
   }
 
 -- | The configuration used in 'Language.Haskell.LSP.Test.runSession'.
 defaultConfig :: SessionConfig
-defaultConfig = SessionConfig 60 False False True Nothing False
+defaultConfig = SessionConfig 60 False False True Nothing False Nothing
 
 instance Default SessionConfig where
   def = defaultConfig
@@ -201,8 +204,8 @@ instance (Monad m, (HasState s m)) => HasState s (ConduitParser a m)
   get = lift get
   put = lift . put
 
-runSessionasdf :: SessionContext -> SessionState -> Session a -> IO (a, SessionState)
-runSessionasdf context state (Session session) = runReaderT (runStateT conduit state) context
+runSessionMonad :: SessionContext -> SessionState -> Session a -> IO (a, SessionState)
+runSessionMonad context state (Session session) = runReaderT (runStateT conduit state) context
   where
     conduit = runConduit $ chanSource .| watchdog .| updateStateC .| runConduitParser (catchError session handler)
 
@@ -261,7 +264,7 @@ runSession' serverIn serverOut mServerProc serverHandler config caps rootDir exi
 
   let context = SessionContext serverIn absRootDir messageChan timeoutIdVar reqMap initRsp config caps
       initState vfs = SessionState 0 vfs mempty False Nothing mempty
-      runSession' ses = initVFS $ \vfs -> runSessionasdf context (initState vfs) ses
+      runSession' ses = initVFS $ \vfs -> runSessionMonad context (initState vfs) ses
 
       errorHandler = throwTo mainThreadId :: SessionException -> IO ()
       serverListenerLauncher =
@@ -284,7 +287,7 @@ runSession' serverIn serverOut mServerProc serverHandler config caps rootDir exi
 
   (result, _) <- bracket serverListenerLauncher
                          serverAndListenerFinalizer
-                         (const $ initVFS $ \vfs -> runSessionasdf context (initState vfs) session)
+                         (const $ initVFS $ \vfs -> runSessionMonad context (initState vfs) session)
   return result
 
 updateStateC :: ConduitM FromServerMessage FromServerMessage (StateT SessionState (ReaderT SessionContext IO)) ()