X-Git-Url: http://git.lukelau.me/?a=blobdiff_plain;f=src%2FLanguage%2FHaskell%2FLSP%2FTest.hs;h=8da170c0d4fe6e984e2d21ffcd05dab6a79cfbc3;hb=bd6901688e6c9d8332fea161260d32666885f9ed;hp=48869b4b4d640c81aa3d39adf87cb6356caee44a;hpb=f6e14409afddc74ea8ffb1d852c316a5374caf2c;p=opengl.git

diff --git a/src/Language/Haskell/LSP/Test.hs b/src/Language/Haskell/LSP/Test.hs
index 48869b4..8da170c 100644
--- a/src/Language/Haskell/LSP/Test.hs
+++ b/src/Language/Haskell/LSP/Test.hs
@@ -16,8 +16,12 @@ module Language.Haskell.LSP.Test
   -- * Sessions
     runSession
   , runSessionWithHandles
-  , runSessionWithCapabilities
+  , runSessionWithConfig
   , Session
+  , SessionConfig(..)
+  , MonadSessionConfig(..)
+  , SessionException(..)
+  , anySessionException
   -- * Sending
   , sendRequest
   , sendNotification
@@ -74,12 +78,12 @@ import qualified Data.ByteString.Lazy.Char8 as B
 import Data.Default
 import qualified Data.Map as Map
 import Data.Maybe
-import Language.Haskell.LSP.Types
-import qualified  Language.Haskell.LSP.Types as LSP (error, id)
-import Language.Haskell.LSP.TH.ClientCapabilities
+import Language.Haskell.LSP.Types hiding (id, capabilities)
+import qualified Language.Haskell.LSP.Types as LSP
 import Language.Haskell.LSP.VFS
 import Language.Haskell.LSP.Test.Compat
 import Language.Haskell.LSP.Test.Decoding
+import Language.Haskell.LSP.Test.Exceptions
 import Language.Haskell.LSP.Test.Parsing
 import Language.Haskell.LSP.Test.Session
 import Language.Haskell.LSP.Test.Server
@@ -93,15 +97,15 @@ runSession :: String -- ^ The command to run the server.
            -> FilePath -- ^ The filepath to the root directory for the session.
            -> Session a -- ^ The session to run.
            -> IO a
-runSession = runSessionWithCapabilities def
+runSession = runSessionWithConfig def
 
 -- | Starts a new sesion with a client with the specified capabilities.
-runSessionWithCapabilities :: ClientCapabilities -- ^ The capabilities the client should have.
+runSessionWithConfig :: SessionConfig -- ^ The capabilities the client should have.
                      -> String -- ^ The command to run the server.
                      -> FilePath -- ^ The filepath to the root directory for the session.
                      -> Session a -- ^ The session to run.
                      -> IO a
-runSessionWithCapabilities caps serverExe rootDir session = do
+runSessionWithConfig config serverExe rootDir session = do
   pid <- getProcessID
   absRootDir <- canonicalizePath rootDir
 
@@ -109,10 +113,11 @@ runSessionWithCapabilities caps serverExe rootDir session = do
                                           (Just $ T.pack absRootDir)
                                           (Just $ filePathToUri absRootDir)
                                           Nothing
-                                          caps
+                                          (capabilities config)
                                           (Just TraceOff)
 
-  withServer serverExe $ \serverIn serverOut _ -> runSessionWithHandles serverIn serverOut listenServer rootDir $ do
+  withServer serverExe $ \serverIn serverOut _ ->
+    runSessionWithHandles serverIn serverOut listenServer config rootDir $ do
 
       -- Wrap the session around initialize and shutdown calls
       sendRequest Initialize initializeParams
@@ -219,6 +224,16 @@ sendNotification TextDocumentDidOpen params = do
   modify (\s -> s { vfs = newVFS })
   sendNotification' n
 
+-- | Close a virtual file if we send a close text document notification
+sendNotification TextDocumentDidClose params = do
+  let params' = fromJust $ decode $ encode params
+      n :: DidCloseTextDocumentNotification
+      n = NotificationMessage "2.0" TextDocumentDidClose params'
+  oldVFS <- vfs <$> get
+  newVFS <- liftIO $ closeVFS oldVFS n
+  modify (\s -> s { vfs = newVFS })
+  sendNotification' n
+
 sendNotification method params = sendNotification' (NotificationMessage "2.0" method params)
 
 sendNotification' :: (ToJSON a, ToJSON b) => NotificationMessage a b -> Session ()