Merge pull request #32 from fendor/tdr-test-impls

Execute getTypeDefinition test

diff --git a/ChangeLog.md b/ChangeLog.md
index 72ae18679eb619391cd0052fffd19003e670a5eb..9397bfde64d484a39456a7a6948e3d2d49588649 100644 (file)
--- a/ChangeLog.md
+++ b/ChangeLog.md
@@ -1,5 +1,13 @@
 # Revision history for lsp-test
 
+## 0.5.2.0 -- 2019-04-28
+
+* Add `satisfy` parser combinator
+
+## 0.5.1.0 -- 2019-04-22
+
+* Fix unhandled `window/progress` server notifications
+
 ## 0.5.1.0 -- 2019-04-07
 
 * Add getTypeDefinitions (@fendor)

diff --git a/lsp-test.cabal b/lsp-test.cabal
index 1c6ca382895b00f9e4f78527b09a4cbee9ab18f4..aca12b0a92e86b2cd904c31573fe71ccd4e479b4 100644 (file)
--- a/lsp-test.cabal
+++ b/lsp-test.cabal
@@ -1,31 +1,31 @@
 name:                lsp-test
-version:             0.5.1.1
+version:             0.5.2.3
 synopsis:            Functional test framework for LSP servers.
 description:
   A test framework for writing tests against
   <https://microsoft.github.io/language-server-protocol/ Language Server Protocol servers>.
   @Language.Haskell.LSP.Test@ launches your server as a subprocess and allows you to simulate a session
   down to the wire, and @Language.Haskell.LSP.Test@ can replay captured sessions from
-  <haskell-lsp-test https://hackage.haskell.org/package/haskell-lsp>.
+  <haskell-lsp https://hackage.haskell.org/package/haskell-lsp>.
   It's currently used for testing in <https://github.com/haskell/haskell-ide-engine haskell-ide-engine>.
-homepage:            https://github.com/Bubba/haskell-lsp-test#readme
+homepage:            https://github.com/bubba/lsp-test#readme
 license:             BSD3
 license-file:        LICENSE
 author:              Luke Lau
 maintainer:          luke_lau@icloud.com
 stability:           experimental
-bug-reports:         https://github.com/Bubba/haskell-lsp-test/issues
+bug-reports:         https://github.com/bubba/lsp-test/issues
 copyright:           2019 Luke Lau
 category:            Testing
 build-type:          Simple
 cabal-version:       2.0
 extra-source-files:  README.md
                    , ChangeLog.md
-tested-with:         GHC == 8.2.2 , GHC == 8.4.2 , GHC == 8.4.3, GHC == 8.6.4
+tested-with:         GHC == 8.2.2 , GHC == 8.4.2 , GHC == 8.4.3, GHC == 8.6.4, GHC == 8.6.5
 
 source-repository head
   type:     git
-  location: https://github.com/Bubba/haskell-lsp-test/
+  location: https://github.com/bubba/lsp-test/
 
 library
   hs-source-dirs:      src
@@ -36,7 +36,7 @@ library
                      , parser-combinators:Control.Applicative.Combinators
   default-language:    Haskell2010
   build-depends:       base >= 4.10 && < 5
-                     , haskell-lsp >= 0.8 && < 0.10
+                     , haskell-lsp >= 0.13.0 && < 0.14
                      , aeson
                      , aeson-pretty
                      , ansi-terminal
@@ -52,10 +52,10 @@ library
                      , mtl
                      , parser-combinators
                      , process
+                     , rope-utf16-splay
                      , text
                      , transformers
                      , unordered-containers
-                     , yi-rope
   if os(windows)
     build-depends:     Win32
   else
@@ -78,7 +78,7 @@ test-suite tests
   build-depends:       base >= 4.10 && < 5
                      , hspec
                      , lens
-                     , haskell-lsp >= 0.8 && < 0.10
+                     , haskell-lsp >= 0.13.0 && < 0.14
                      , lsp-test
                      , data-default
                      , aeson

diff --git a/src/Language/Haskell/LSP/Test.hs b/src/Language/Haskell/LSP/Test.hs
index 3b40842dd7ff169c69e3b1bbb3e2210a4d0eaaf0..15cb2a164d4600530cbc6a626f8fedbfee7890f9 100644 (file)
--- a/src/Language/Haskell/LSP/Test.hs
+++ b/src/Language/Haskell/LSP/Test.hs
@@ -41,7 +41,9 @@ module Language.Haskell.LSP.Test
   , initializeResponse
   -- ** Documents
   , openDoc
+  , openDoc'
   , closeDoc
+  , changeDoc
   , documentContents
   , getDocumentEdit
   , getDocUri
@@ -108,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.
 --
@@ -283,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.
@@ -298,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 ()
@@ -318,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
@@ -351,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
@@ -436,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)
 
@@ -449,7 +463,7 @@ applyEdit doc edit = do
   caps <- asks sessionCapabilities
 
   let supportsDocChanges = fromMaybe False $ do
-        let C.ClientCapabilities mWorkspace _ _ = caps
+        let mWorkspace = C._workspace caps
         C.WorkspaceClientCapabilities _ mEdit _ _ _ _ _ _ <- mWorkspace
         C.WorkspaceEditClientCapabilities mDocChanges <- mEdit
         mDocChanges

diff --git a/src/Language/Haskell/LSP/Test/Decoding.hs b/src/Language/Haskell/LSP/Test/Decoding.hs
index 2cbc41c07354f9c10f81ab902379085e52d5ed72..337dee371db5ae67cbe3f898e1f8401a4d05609a 100644 (file)
--- a/src/Language/Haskell/LSP/Test/Decoding.hs
+++ b/src/Language/Haskell/LSP/Test/Decoding.hs
@@ -131,6 +131,9 @@ decodeFromServerMsg reqMap bytes =
         WindowShowMessage              -> NotShowMessage $ fromJust $ decode bytes
         WindowLogMessage               -> NotLogMessage $ fromJust $ decode bytes
         CancelRequestServer            -> NotCancelRequestFromServer $ fromJust $ decode bytes
+        WindowProgressStart            -> NotProgressStart $ fromJust $ decode bytes
+        WindowProgressReport           -> NotProgressReport $ fromJust $ decode bytes
+        WindowProgressDone             -> NotProgressDone $ fromJust $ decode bytes
         TelemetryEvent                 -> NotTelemetry $ fromJust $ decode bytes
         WindowShowMessageRequest       -> ReqShowMessage $ fromJust $ decode bytes
         ClientRegisterCapability       -> ReqRegisterCapability $ fromJust $ decode bytes

diff --git a/src/Language/Haskell/LSP/Test/Messages.hs b/src/Language/Haskell/LSP/Test/Messages.hs
index 02fa7fc41dd2f6e7dec83cfd3a9cfc59d3a0694a..1a3805f07ff3d5cecc28adf08f345e8e8be66cb6 100644 (file)
--- a/src/Language/Haskell/LSP/Test/Messages.hs
+++ b/src/Language/Haskell/LSP/Test/Messages.hs
@@ -90,6 +90,9 @@ handleServerMessage request response notification msg = case msg of
     (NotPublishDiagnostics       m) -> notification m
     (NotLogMessage               m) -> notification m
     (NotShowMessage              m) -> notification m
+    (NotProgressStart            m) -> notification m
+    (NotProgressReport           m) -> notification m
+    (NotProgressDone             m) -> notification m
     (NotTelemetry                m) -> notification m
     (NotCancelRequestFromServer  m) -> notification m
 
@@ -141,4 +144,5 @@ handleClientMessage request response notification msg = case msg of
  (NotDidSaveTextDocument      m) -> notification m
  (NotDidChangeWatchedFiles    m) -> notification m
  (NotDidChangeWorkspaceFolders m) -> notification m
+ (NotProgressCancel           m) -> notification m
  (UnknownFromClientMessage    m) -> error $ "Unknown message sent from client: " ++ show m

diff --git a/src/Language/Haskell/LSP/Test/Parsing.hs b/src/Language/Haskell/LSP/Test/Parsing.hs
index 1fd394f3db1ee96a6810a25fa4e62e9be9f235e2..09006b67859957aedab3ac045a3926ad09598037 100644 (file)
--- a/src/Language/Haskell/LSP/Test/Parsing.hs
+++ b/src/Language/Haskell/LSP/Test/Parsing.hs
@@ -5,7 +5,8 @@
 
 module Language.Haskell.LSP.Test.Parsing
   ( -- $receiving
-    message
+    satisfy
+  , message
   , anyRequest
   , anyResponse
   , anyNotification
@@ -60,6 +61,9 @@ import Language.Haskell.LSP.Test.Session
 --               anyResponse
 -- @
 
+-- | Consumes and returns the next message, if it satisfies the specified predicate.
+--
+-- @since 0.5.2.0
 satisfy :: (FromServerMessage -> Bool) -> Session FromServerMessage
 satisfy pred = do
 
@@ -85,7 +89,7 @@ satisfy pred = do
       return x
     else empty
 
--- | Matches a message of type 'a'.
+-- | Matches a message of type @a@.
 message :: forall a. (Typeable a, FromJSON a) => Session a
 message =
   let parser = decode . encodeMsg :: FromServerMessage -> Maybe a

diff --git a/src/Language/Haskell/LSP/Test/Session.hs b/src/Language/Haskell/LSP/Test/Session.hs
index 700d9ccc84c233314f9c581bfd6bf8f810c8c1d5..a3ba35b3a1a46f723d4ca0fce59775991680c862 100644 (file)
--- a/src/Language/Haskell/LSP/Test/Session.hs
+++ b/src/Language/Haskell/LSP/Test/Session.hs
@@ -68,9 +68,10 @@ import System.IO
 
 -- | A session representing one instance of launching and connecting to a server.
 --
--- You can send and receive messages to the server within 'Session' via 'getMessage',
--- 'sendRequest' and 'sendNotification'.
---
+-- You can send and receive messages to the server within 'Session' via
+-- 'Language.Haskell.LSP.Test.message',
+-- 'Language.Haskell.LSP.Test.sendRequest' and
+-- 'Language.Haskell.LSP.Test.sendNotification'.
 
 type Session = ParserStateReader FromServerMessage SessionState SessionContext IO
 
@@ -255,7 +256,7 @@ updateState (ReqApplyWorkspaceEdit r) = do
   forM_ bumpedVersions $ \(VersionedTextDocumentIdentifier uri v) ->
     modify $ \s ->
       let oldVFS = vfs s
-          update (VirtualFile oldV t) = VirtualFile (fromMaybe oldV v) t
+          update (VirtualFile oldV t mf) = VirtualFile (fromMaybe oldV v) t mf
           newVFS = Map.adjust update uri oldVFS
       in s { vfs = newVFS }
 
@@ -296,7 +297,7 @@ sendMessage msg = do
   logMsg LogClient msg
   liftIO $ B.hPut h (addHeader $ encode msg)
 
--- | Execute a block f that will throw a 'TimeoutException'
+-- | Execute a block f that will throw a 'Timeout' exception
 -- after duration seconds. This will override the global timeout
 -- for waiting for messages to arrive defined in 'SessionConfig'.
 withTimeout :: Int -> Session a -> Session a

diff --git a/stack.yaml b/stack.yaml
index 6ee01be904caa33e576ded88aca330b502c13059..26a1ba2b1913627dfa9b3e565b7a2fe82c9f7d84 100644 (file)
--- a/stack.yaml
+++ b/stack.yaml
@@ -1,6 +1,8 @@
-resolver: lts-13.15
+resolver: lts-13.21
 packages:
   - .
+
 extra-deps:
-- haskell-lsp-0.9.0.0
-- haskell-lsp-types-0.9.0.0
+  - haskell-lsp-0.13.0.0
+  - haskell-lsp-types-0.13.0.0
+  - rope-utf16-splay-0.3.1.0

diff --git a/test/Test.hs b/test/Test.hs
index 2372cbefff91ebf9c2b6004a301d6cab0a1e5f63..380c98b90aedf2c9c498ed3f1539d010edeafc15 100644 (file)
--- a/test/Test.hs
+++ b/test/Test.hs
@@ -319,6 +319,13 @@ main = hspec $ do
               documentContents doc >>= liftIO . print
       in sesh `shouldThrow` anyException
 
+  describe "satisfy" $
+    it "works" $ runSession "hie" fullCaps "test/data" $ do
+      openDoc "Format.hs" "haskell"
+      let pred (NotLogMessage _) = True
+          pred _ = False
+      void $ satisfy pred
+
 mkRange sl sc el ec = Range (Position sl sc) (Position el ec)
 
 didChangeCaps :: ClientCapabilities