From: Luke Lau Date: Wed, 20 Jun 2018 16:41:51 +0000 (+0100) Subject: Merge branch 'master' of https://github.com/Bubba/haskell-lsp-test X-Git-Url: http://git.lukelau.me/?p=opengl.git;a=commitdiff_plain;h=f6e14409afddc74ea8ffb1d852c316a5374caf2c;hp=-c Merge branch 'master' of https://github.com/Bubba/haskell-lsp-test --- f6e14409afddc74ea8ffb1d852c316a5374caf2c diff --combined haskell-lsp-test.cabal index 51f5fb9,810a113..eef87c6 --- a/haskell-lsp-test.cabal +++ b/haskell-lsp-test.cabal @@@ -20,7 -20,7 +20,7 @@@ librar default-language: Haskell2010 build-depends: base >= 4.7 && < 5 , haskell-lsp-types - , haskell-lsp + , haskell-lsp >= 0.3 , aeson , bytestring , conduit @@@ -35,7 -35,6 +35,7 @@@ , text , transformers , unordered-containers + , yi-rope if os(windows) build-depends: Win32 else @@@ -57,9 -56,11 +57,11 @@@ test-suite test build-depends: base >= 4.7 && < 5 , hspec , lens + , data-default , directory , haskell-lsp-test , haskell-lsp + , haskell-lsp-types , conduit , conduit-parse , aeson diff --combined src/Language/Haskell/LSP/Test.hs index b2d731e,7f13a59..48869b4 --- a/src/Language/Haskell/LSP/Test.hs +++ b/src/Language/Haskell/LSP/Test.hs @@@ -16,6 -16,7 +16,7 @@@ module Language.Haskell.LSP.Tes -- * Sessions runSession , runSessionWithHandles + , runSessionWithCapabilities , Session -- * Sending , sendRequest @@@ -57,12 -58,12 +58,12 @@@ , getInitializeResponse , openDoc , getDocItem + , documentContents , getDocUri ) where import Control.Applicative import Control.Applicative.Combinators -import Control.Monad import Control.Monad.IO.Class import Control.Concurrent import Control.Lens hiding ((.=), List) @@@ -71,10 -72,13 +72,11 @@@ import qualified Data.Text.IO as import Data.Aeson import qualified Data.ByteString.Lazy.Char8 as B import Data.Default -import Data.Foldable -import qualified Data.HashMap.Strict as HashMap -import Data.List +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.Messages import Language.Haskell.LSP.VFS import Language.Haskell.LSP.Test.Compat import Language.Haskell.LSP.Test.Decoding @@@ -84,14 -88,21 +86,22 @@@ import Language.Haskell.LSP.Test.Serve import System.IO import System.Directory import System.FilePath +import qualified Yi.Rope as Rope -- | Starts a new session. 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 serverExe rootDir session = do + runSession = runSessionWithCapabilities def + + -- | Starts a new sesion with a client with the specified capabilities. + runSessionWithCapabilities :: ClientCapabilities -- ^ 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 absRootDir <- canonicalizePath rootDir @@@ -99,7 -110,7 +109,7 @@@ (Just $ T.pack absRootDir) (Just $ filePathToUri absRootDir) Nothing - def + caps (Just TraceOff) withServer serverExe $ \serverIn serverOut _ -> runSessionWithHandles serverIn serverOut listenServer rootDir $ do @@@ -132,16 -143,38 +142,16 @@@ listenServer serverOut = d reqMap <- liftIO $ readMVar $ requestMap context let msg = decodeFromServerMsg reqMap msgBytes - processTextChanges msg liftIO $ writeChan (messageChan context) msg listenServer serverOut -processTextChanges :: FromServerMessage -> Session () -processTextChanges (ReqApplyWorkspaceEdit r) = do - List changeParams <- case r ^. params . edit . documentChanges of - Just cs -> mapM applyTextDocumentEdit cs - Nothing -> case r ^. params . edit . changes of - Just cs -> mapM (uncurry applyTextEdit) (List (HashMap.toList cs)) - Nothing -> return (List []) - - let groupedParams = groupBy (\a b -> (a ^. textDocument == b ^. textDocument)) changeParams - mergedParams = map mergeParams groupedParams - - forM_ mergedParams (sendNotification TextDocumentDidChange) - - where applyTextDocumentEdit (TextDocumentEdit docId (List edits)) = do - oldVFS <- vfs <$> get - let changeEvents = map (\e -> TextDocumentContentChangeEvent (Just (e ^. range)) Nothing (e ^. newText)) edits - params = DidChangeTextDocumentParams docId (List changeEvents) - newVFS <- liftIO $ changeVFS oldVFS (fmClientDidChangeTextDocumentNotification params) - modify (\s -> s { vfs = newVFS }) - return params - - applyTextEdit uri edits = applyTextDocumentEdit (TextDocumentEdit (VersionedTextDocumentIdentifier uri 0) edits) - - mergeParams :: [DidChangeTextDocumentParams] -> DidChangeTextDocumentParams - mergeParams params = let events = concat (toList (map (toList . (^. contentChanges)) params)) - in DidChangeTextDocumentParams (head params ^. textDocument) (List events) -processTextChanges _ = return () +-- | The current text contents of a document. +documentContents :: TextDocumentIdentifier -> Session T.Text +documentContents doc = do + vfs <- vfs <$> get + let file = vfs Map.! (doc ^. uri) + return $ Rope.toText $ Language.Haskell.LSP.VFS._text file -- | Sends a request to the server. -- @@@ -198,18 -231,9 +208,18 @@@ sendNotification :: ToJSON => ClientMethod -- ^ The notification method. -> a -- ^ The notification parameters. -> Session () -sendNotification method params = - let notif = NotificationMessage "2.0" method params - in sendNotification' notif + +-- | Open a virtual file if we send a did open text document notification +sendNotification TextDocumentDidOpen params = do + let params' = fromJust $ decode $ encode params + n :: DidOpenTextDocumentNotification + n = NotificationMessage "2.0" TextDocumentDidOpen params' + oldVFS <- vfs <$> get + newVFS <- liftIO $ openVFS 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 () sendNotification' = sendMessage @@@ -251,4 -275,3 +261,4 @@@ getDocUri file = d context <- ask let fp = rootDir context file return $ filePathToUri fp + diff --combined test/Test.hs index d615cb9,0bffa5e..d83d03d --- a/test/Test.hs +++ b/test/Test.hs @@@ -4,6 -4,7 +4,7 @@@ {-# LANGUAGE DeriveAnyClass #-} import Test.Hspec import Data.Aeson + import Data.Default import qualified Data.HashMap.Strict as HM import Data.Maybe import Control.Monad.IO.Class @@@ -11,6 -12,7 +12,7 @@@ import Control.Lens hiding (L import GHC.Generics import Language.Haskell.LSP.Test import Language.Haskell.LSP.Test.Replay + import Language.Haskell.LSP.TH.ClientCapabilities import Language.Haskell.LSP.Types import ParsingTests @@@ -45,6 -47,12 +47,12 @@@ main = hspec $ d rsp <- getInitializeResponse liftIO $ rsp ^. result `shouldNotBe` Nothing + it "can register specific capabilities" $ do + let caps = def { _workspace = Just workspaceCaps } + workspaceCaps = def { _didChangeConfiguration = Just configCaps } + configCaps = DidChangeConfigurationClientCapabilities (Just True) + runSessionWithCapabilities caps "hie --lsp" "test/data/renamePass" $ return () + describe "replay session" $ do it "passes a test" $ replaySession "hie --lsp" "test/data/renamePass" `shouldReturn` True @@@ -88,9 -96,6 +96,9 @@@ checkNoDiagnostics + contents <- documentContents doc + liftIO $ contents `shouldBe` "main :: IO Int\nmain = return 42" + parsingSpec data ApplyOneParams = AOP