Tidy up rebase

[lsp-test.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 f9444f65678dab07d19df95e5d1970af886f91ed..b98dca84f975ccfd10035b27a43476e969090002 100644 (file)
--- 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,30 +264,27 @@ 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 =
         forkIO $ catch (serverHandler serverOut context) errorHandler
-      server = (Just serverIn, Just serverOut, Nothing, serverProc)
       msgTimeoutMs = messageTimeout config * 10^6
       serverAndListenerFinalizer tid = do
         let cleanup
-              | Just sp <- mServerProc = cleanupProcess (Just serverIn, Just serverOut, Nothing, sp)
+              | Just sp <- mServerProc = do
+                  -- Give the server some time to exit cleanly
+                  timeout msgTimeoutMs (waitForProcess sp)
+                  cleanupProcess (Just serverIn, Just serverOut, Nothing, sp)
               | otherwise = pure ()
-        finally (timeout msgTimeoutMs (runSession' exitServer)) $ do
+        finally (timeout msgTimeoutMs (runSession' exitServer))
                 -- Make sure to kill the listener first, before closing
                 -- handles etc via cleanupProcess
-                killThread tid
-                -- Give the server some time to exit cleanly
-#ifndef mingw32_HOST_OS
-                timeout msgTimeoutMs (waitForProcess serverProc)
-#endif
-                cleanup
+                (killThread tid >> cleanup)
 
   (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)) ()