X-Git-Url: http://git.lukelau.me/?a=blobdiff_plain;f=src%2FLanguage%2FHaskell%2FLSP%2FTest.hs;h=15cb2a164d4600530cbc6a626f8fedbfee7890f9;hb=01cfd5ae44e86182adf1cee0a3e5769e3f1586d3;hp=ec290ff9833b0d79af1e861f825d7850a407caf3;hpb=39932423ee0fcc8dd500aea4ff558d1b72440a17;p=lsp-test.git diff --git a/src/Language/Haskell/LSP/Test.hs b/src/Language/Haskell/LSP/Test.hs index ec290ff..15cb2a1 100644 --- a/src/Language/Haskell/LSP/Test.hs +++ b/src/Language/Haskell/LSP/Test.hs @@ -23,7 +23,7 @@ module Language.Haskell.LSP.Test , runSessionWithConfig , SessionConfig(..) , defaultConfig - , module Language.Haskell.LSP.Types.Capabilities + , C.fullCaps -- ** Exceptions , module Language.Haskell.LSP.Test.Exceptions , withTimeout @@ -41,7 +41,9 @@ module Language.Haskell.LSP.Test , initializeResponse -- ** Documents , openDoc + , openDoc' , closeDoc + , changeDoc , documentContents , getDocumentEdit , getDocUri @@ -65,6 +67,7 @@ module Language.Haskell.LSP.Test , getReferences -- ** Definitions , getDefinitions + , getTypeDefinitions -- ** Renaming , rename -- ** Hover @@ -91,9 +94,11 @@ import Data.Default import qualified Data.HashMap.Strict as HashMap import qualified Data.Map as Map import Data.Maybe -import Language.Haskell.LSP.Types hiding (id, capabilities, message) -import qualified Language.Haskell.LSP.Types as LSP -import Language.Haskell.LSP.Types.Capabilities +import Language.Haskell.LSP.Types +import Language.Haskell.LSP.Types.Lens hiding + (id, capabilities, message, executeCommand, applyEdit, rename) +import qualified Language.Haskell.LSP.Types.Lens as LSP +import qualified Language.Haskell.LSP.Types.Capabilities as C import Language.Haskell.LSP.Messages import Language.Haskell.LSP.VFS import Language.Haskell.LSP.Test.Compat @@ -105,7 +110,7 @@ import Language.Haskell.LSP.Test.Server import System.IO import System.Directory import System.FilePath -import qualified Yi.Rope as Rope +import qualified Data.Rope.UTF16 as Rope -- | Starts a new session. -- @@ -116,7 +121,7 @@ import qualified Yi.Rope as Rope -- > params = TextDocumentPositionParams doc -- > hover <- request TextDocumentHover params runSession :: String -- ^ The command to run the server. - -> ClientCapabilities -- ^ The capabilities that the client should declare. + -> C.ClientCapabilities -- ^ The capabilities that the client should declare. -> FilePath -- ^ The filepath to the root directory for the session. -> Session a -- ^ The session to run. -> IO a @@ -125,7 +130,7 @@ runSession = runSessionWithConfig def -- | Starts a new sesion with a custom configuration. runSessionWithConfig :: SessionConfig -- ^ Configuration options for the session. -> String -- ^ The command to run the server. - -> ClientCapabilities -- ^ The capabilities that the client should declare. + -> C.ClientCapabilities -- ^ The capabilities that the client should declare. -> FilePath -- ^ The filepath to the root directory for the session. -> Session a -- ^ The session to run. -> IO a @@ -139,6 +144,7 @@ runSessionWithConfig config serverExe caps rootDir session = do Nothing caps (Just TraceOff) + Nothing withServer serverExe (logStdErr config) $ \serverIn serverOut _ -> runSessionWithHandles serverIn serverOut listenServer config caps rootDir $ do @@ -152,6 +158,10 @@ runSessionWithConfig config serverExe caps rootDir session = do sendNotification Initialized InitializedParams + case lspConfig config of + Just cfg -> sendNotification WorkspaceDidChangeConfiguration (DidChangeConfigurationParams cfg) + Nothing -> return () + -- Run the actual test result <- session @@ -275,6 +285,15 @@ sendNotification TextDocumentDidClose params = do modify (\s -> s { vfs = newVFS }) sendMessage n +sendNotification TextDocumentDidChange params = do + let params' = fromJust $ decode $ encode params + n :: DidChangeTextDocumentNotification + n = NotificationMessage "2.0" TextDocumentDidChange params' + oldVFS <- vfs <$> get + newVFS <- liftIO $ changeFromClientVFS oldVFS n + modify (\s -> s { vfs = newVFS }) + sendMessage n + sendNotification method params = sendMessage (NotificationMessage "2.0" method params) -- | Sends a response to the server. @@ -290,19 +309,20 @@ initializeResponse = initRsp <$> ask >>= (liftIO . readMVar) -- | Opens a text document and sends a notification to the client. openDoc :: FilePath -> String -> Session TextDocumentIdentifier 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. - -> Session TextDocumentItem - getDocItem file languageId = do context <- ask let fp = rootDir context file contents <- liftIO $ T.readFile fp - return $ TextDocumentItem (filePathToUri fp) (T.pack languageId) 0 contents + openDoc' file languageId contents + +-- | This is a variant of `openDoc` that takes the file content as an argument. +openDoc' :: FilePath -> String -> T.Text -> Session TextDocumentIdentifier +openDoc' file languageId contents = do + context <- ask + let fp = rootDir context file + uri = filePathToUri fp + item = TextDocumentItem uri (T.pack languageId) 0 contents + sendNotification TextDocumentDidOpen (DidOpenTextDocumentParams item) + pure $ TextDocumentIdentifier uri -- | Closes a text document and sends a notification to the client. closeDoc :: TextDocumentIdentifier -> Session () @@ -310,10 +330,12 @@ closeDoc docId = do let params = DidCloseTextDocumentParams (TextDocumentIdentifier (docId ^. uri)) sendNotification TextDocumentDidClose params - oldVfs <- vfs <$> get - let notif = NotificationMessage "" TextDocumentDidClose params - newVfs <- liftIO $ closeVFS oldVfs notif - modify $ \s -> s { vfs = newVfs } +-- | Changes a text document and sends a notification to the client +changeDoc :: TextDocumentIdentifier -> [TextDocumentContentChangeEvent] -> Session () +changeDoc docId changes = do + verDoc <- getVersionedDoc docId + let params = DidChangeTextDocumentParams (verDoc & version . non 0 +~ 1) (List changes) + sendNotification TextDocumentDidChange params -- | Gets the Uri for the file corrected to the session directory. getDocUri :: FilePath -> Session Uri @@ -343,7 +365,7 @@ waitForDiagnosticsSource src = do matches d = d ^. source == Just (T.pack src) -- | Expects a 'PublishDiagnosticsNotification' and throws an --- 'UnexpectedDiagnosticsException' if there are any diagnostics +-- 'UnexpectedDiagnostics' exception if there are any diagnostics -- returned. noDiagnostics :: Session () noDiagnostics = do @@ -428,7 +450,7 @@ getVersionedDoc (TextDocumentIdentifier uri) = do fs <- vfs <$> get let ver = case fs Map.!? uri of - Just (VirtualFile v _) -> Just v + Just (VirtualFile v _ _) -> Just v _ -> Nothing return (VersionedTextDocumentIdentifier uri ver) @@ -441,9 +463,9 @@ applyEdit doc edit = do caps <- asks sessionCapabilities let supportsDocChanges = fromMaybe False $ do - let ClientCapabilities mWorkspace _ _ = caps - WorkspaceClientCapabilities _ mEdit _ _ _ _ _ _ <- mWorkspace - WorkspaceEditClientCapabilities mDocChanges <- mEdit + let mWorkspace = C._workspace caps + C.WorkspaceClientCapabilities _ mEdit _ _ _ _ _ _ <- mWorkspace + C.WorkspaceEditClientCapabilities mDocChanges <- mEdit mDocChanges let wEdit = if supportsDocChanges @@ -487,6 +509,14 @@ getDefinitions doc pos = let params = TextDocumentPositionParams doc pos in getResponseResult <$> request TextDocumentDefinition params +-- | Returns the type definition(s) for the term at the specified position. +getTypeDefinitions :: TextDocumentIdentifier -- ^ The document the term is in. + -> Position -- ^ The position the term is at. + -> Session [Location] -- ^ The location(s) of the definitions +getTypeDefinitions doc pos = + let params = TextDocumentPositionParams doc pos + in getResponseResult <$> request TextDocumentTypeDefinition params + -- | Renames the term at the specified position. rename :: TextDocumentIdentifier -> Position -> String -> Session () rename doc pos newName = do