X-Git-Url: http://git.lukelau.me/?a=blobdiff_plain;f=src%2FLanguage%2FHaskell%2FLSP%2FTest.hs;h=1ce6871fb211f3a66e75f7ac95d65bbb979a4085;hb=269f303e5e44fba835c51eacfca622c488a06b9f;hp=d3b1b65e4c5a7b9c2e9e5190897852e87a2ec018;hpb=ea5db1975df3a208798ce2c44dc71fb8123fabd3;p=lsp-test.git

diff --git a/src/Language/Haskell/LSP/Test.hs b/src/Language/Haskell/LSP/Test.hs
index d3b1b65..1ce6871 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
@@ -55,31 +59,37 @@ module Language.Haskell.LSP.Test
   , (<|>)
   , satisfy
   -- * Utilities
-  , getInitializeResponse
+  , initializeResponse
   , openDoc
-  , getDocItem
   , documentContents
+  , getDocumentEdit
   , getDocUri
+  , noDiagnostics
+  , getDocumentSymbols
+  , getDiagnostics
   ) where
 
 import Control.Applicative
 import Control.Applicative.Combinators
-import Control.Monad.IO.Class
 import Control.Concurrent
+import Control.Monad
+import Control.Monad.IO.Class
+import Control.Exception
 import Control.Lens hiding ((.=), List)
 import qualified Data.Text as T
 import qualified Data.Text.IO as T
 import Data.Aeson
 import qualified Data.ByteString.Lazy.Char8 as B
 import Data.Default
+import qualified Data.HashMap.Strict as HashMap
 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,26 +103,26 @@ 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
-  pid <- getProcessID
+runSessionWithConfig config serverExe rootDir session = do
+  pid <- getCurrentProcessID
   absRootDir <- canonicalizePath rootDir
 
   let initializeParams = InitializeParams (Just pid)
                                           (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 (logStdErr config) $ \serverIn serverOut _ ->
+    runSessionWithHandles serverIn serverOut listenServer config rootDir $ do
 
       -- Wrap the session around initialize and shutdown calls
       sendRequest Initialize initializeParams
@@ -153,6 +163,29 @@ documentContents doc = do
   let file = vfs Map.! (doc ^. uri)
   return $ Rope.toText $ Language.Haskell.LSP.VFS._text file
 
+-- | Parses an ApplyEditRequest, checks that it is for the passed document
+-- and returns the new content
+getDocumentEdit :: TextDocumentIdentifier -> Session T.Text
+getDocumentEdit doc = do
+  req <- request :: Session ApplyWorkspaceEditRequest
+
+  unless (checkDocumentChanges req || checkChanges req) $
+    liftIO $ throw (IncorrectApplyEditRequestException (show req))
+
+  documentContents doc
+  where
+    checkDocumentChanges :: ApplyWorkspaceEditRequest -> Bool
+    checkDocumentChanges req =
+      let changes = req ^. params . edit . documentChanges
+          maybeDocs = fmap (fmap (^. textDocument . uri)) changes
+      in case maybeDocs of
+        Just docs -> (doc ^. uri) `elem` docs
+        Nothing -> False
+    checkChanges :: ApplyWorkspaceEditRequest -> Bool
+    checkChanges req =
+      let mMap = req ^. params . edit . changes
+        in maybe False (HashMap.member (doc ^. uri)) mMap
+
 -- | Sends a request to the server.
 --
 -- @
@@ -245,8 +278,8 @@ sendMessage msg = do
 -- | Returns the initialize response that was received from the server.
 -- The initialize requests and responses are not included the session,
 -- so if you need to test it use this.
-getInitializeResponse :: Session InitializeResponse
-getInitializeResponse = initRsp <$> ask >>= (liftIO . readMVar)
+initializeResponse :: Session InitializeResponse
+initializeResponse = initRsp <$> ask >>= (liftIO . readMVar)
 
 -- | Opens a text document and sends a notification to the client.
 openDoc :: FilePath -> String -> Session TextDocumentIdentifier
@@ -254,7 +287,7 @@ openDoc file languageId = do
   item <- getDocItem file languageId
   sendNotification TextDocumentDidOpen (DidOpenTextDocumentParams item)
   TextDocumentIdentifier <$> getDocUri file
-
+  where
   -- | Reads in a text document as the first version.
   getDocItem :: FilePath -- ^ The path to the text document to read in.
             -> String -- ^ The language ID, e.g "haskell" for .hs files.
@@ -272,3 +305,22 @@ getDocUri file = do
   let fp = rootDir context </> file
   return $ filePathToUri fp
 
+getDiagnostics :: Session [Diagnostic]
+getDiagnostics = do
+  diagsNot <- notification :: Session PublishDiagnosticsNotification
+  let (List diags) = diagsNot ^. params . LSP.diagnostics
+  return diags
+
+-- | Expects a 'PublishDiagnosticsNotification' and throws an
+-- 'UnexpectedDiagnosticsException' if there are any diagnostics
+-- returned.
+noDiagnostics :: Session ()
+noDiagnostics = do
+  diagsNot <- notification :: Session PublishDiagnosticsNotification
+  when (diagsNot ^. params . LSP.diagnostics /= List []) $ liftIO $ throw UnexpectedDiagnosticsException
+
+-- | Returns the symbols in a document.
+getDocumentSymbols :: TextDocumentIdentifier -> Session DocumentSymbolsResponse
+getDocumentSymbols doc = do
+  sendRequest TextDocumentDocumentSymbol (DocumentSymbolParams doc)
+  response
\ No newline at end of file