Merge branch 'master' into github-actions
authorLuke Lau <luke_lau@icloud.com>
Fri, 20 Dec 2019 00:01:01 +0000 (00:01 +0000)
committerLuke Lau <luke_lau@icloud.com>
Fri, 20 Dec 2019 00:01:01 +0000 (00:01 +0000)
.gitignore
ChangeLog.md
lsp-test.cabal
src/Language/Haskell/LSP/Test.hs
src/Language/Haskell/LSP/Test/Exceptions.hs
src/Language/Haskell/LSP/Test/Session.hs
stack.yaml
stack.yaml.lock [deleted file]
test/Test.hs

index b057681729a1b050fbeb1191b01f9e355558d9fa..223787e31526c16f4b2901ab70c869175664dbf9 100644 (file)
@@ -1,4 +1,5 @@
 .stack-work
+stack.yaml.lock
 dist
 .cabal-sandbox
 cabal.sandbox.config
index c75f2c6834648570689b339c5a1966358fe0e67d..17c926ad4783e1209c39616275db5095b5f6f0db 100644 (file)
@@ -1,5 +1,12 @@
 # Revision history for lsp-test
 
+## 0.9.0.0 -- 2019-12-1
+
+* Add `ignoreLogNotifications` config option
+* Add ability to override `logStdErr` and `logMessages` config options with
+  the `LSP_TEST_LOG_STDERR` and `LOG_TEST_LOG_MESSAGES` environment variables
+* Update for haskell-lsp-0.19.0.0 (@mpickering)
+
 ## 0.8.2.0 -- 2019-11-17
 
 * Expose `satisfyMaybe` (@cocreature)
index bdb4275d5536602de9c04a1f8077334e84a098f4..0d436112883ceee892ae03dfd2e51e7522636b2d 100644 (file)
@@ -1,5 +1,5 @@
 name:                lsp-test
-version:             0.8.2.0
+version:             0.9.0.0
 synopsis:            Functional test framework for LSP servers.
 description:
   A test framework for writing tests against
@@ -13,7 +13,6 @@ license:             BSD3
 license-file:        LICENSE
 author:              Luke Lau
 maintainer:          luke_lau@icloud.com
-stability:           experimental
 bug-reports:         https://github.com/bubba/lsp-test/issues
 copyright:           2019 Luke Lau
 category:            Testing
@@ -36,7 +35,7 @@ library
                      , parser-combinators:Control.Applicative.Combinators
   default-language:    Haskell2010
   build-depends:       base >= 4.10 && < 5
-                     , haskell-lsp == 0.18.*
+                     , haskell-lsp == 0.19.*
                      , aeson
                      , aeson-pretty
                      , ansi-terminal
@@ -53,7 +52,6 @@ library
                      , mtl
                      , parser-combinators
                      , process >= 1.6
-                     , rope-utf16-splay
                      , text
                      , transformers
                      , unordered-containers
@@ -79,7 +77,7 @@ test-suite tests
   build-depends:       base >= 4.10 && < 5
                      , hspec
                      , lens
-                     , haskell-lsp == 0.18.*
+                     , haskell-lsp == 0.19.*
                      , lsp-test
                      , data-default
                      , aeson
index a6612e2c49c6aaffc3148c44bb285e35d8c46bae..3ad7b2f042b34d3a3fd4f18530fbc256ac8e9b7c 100644 (file)
@@ -37,6 +37,7 @@ module Language.Haskell.LSP.Test
   , module Language.Haskell.LSP.Test.Parsing
   -- * Utilities
   -- | Quick helper functions for common tasks.
+
   -- ** Initialization
   , initializeResponse
   -- ** Documents
@@ -109,10 +110,10 @@ import Language.Haskell.LSP.Test.Exceptions
 import Language.Haskell.LSP.Test.Parsing
 import Language.Haskell.LSP.Test.Session
 import Language.Haskell.LSP.Test.Server
+import System.Environment
 import System.IO
 import System.Directory
 import System.FilePath
-import qualified Data.Rope.UTF16 as Rope
 
 -- | Starts a new session.
 --
@@ -136,10 +137,12 @@ runSessionWithConfig :: SessionConfig -- ^ Configuration options for the session
                      -> FilePath -- ^ The filepath to the root directory for the session.
                      -> Session a -- ^ The session to run.
                      -> IO a
-runSessionWithConfig config serverExe caps rootDir session = do
+runSessionWithConfig config' serverExe caps rootDir session = do
   pid <- getCurrentProcessID
   absRootDir <- canonicalizePath rootDir
 
+  config <- envOverrideConfig config'
+
   let initializeParams = InitializeParams (Just pid)
                                           (Just $ T.pack absRootDir)
                                           (Just $ filePathToUri absRootDir)
@@ -184,12 +187,23 @@ runSessionWithConfig config serverExe caps rootDir session = do
       (RspShutdown _) -> return ()
       _               -> listenServer serverOut context
 
+  -- | Check environment variables to override the config
+  envOverrideConfig :: SessionConfig -> IO SessionConfig
+  envOverrideConfig cfg = do
+    logMessages' <- fromMaybe (logMessages cfg) <$> checkEnv "LSP_TEST_LOG_MESSAGES"
+    logStdErr' <- fromMaybe (logStdErr cfg) <$> checkEnv "LSP_TEST_LOG_STDERR"
+    return $ cfg { logMessages = logMessages', logStdErr = logStdErr' }
+    where checkEnv :: String -> IO (Maybe Bool)
+          checkEnv s = fmap convertVal <$> lookupEnv s
+          convertVal "0" = False
+          convertVal _ = True
+
 -- | The current text contents of a document.
 documentContents :: TextDocumentIdentifier -> Session T.Text
 documentContents doc = do
   vfs <- vfs <$> get
   let file = vfsMap vfs Map.! toNormalizedUri (doc ^. uri)
-  return $ Rope.toText $ Language.Haskell.LSP.VFS._text file
+  return (virtualFileText file)
 
 -- | Parses an ApplyEditRequest, checks that it is for the passed document
 -- and returns the new content
@@ -452,7 +466,7 @@ getVersionedDoc (TextDocumentIdentifier uri) = do
   fs <- vfsMap . vfs <$> get
   let ver =
         case fs Map.!? toNormalizedUri uri of
-          Just (VirtualFile v _) -> Just v
+          Just vf -> Just (virtualFileVersion vf)
           _ -> Nothing
   return (VersionedTextDocumentIdentifier uri ver)
 
index dd31ea3cc155d879ba5366966b04e9b4ca5a4808..713b25f101a23429668a1f29207e8f2c4a63645e 100644 (file)
@@ -11,7 +11,7 @@ import Data.List
 import qualified Data.ByteString.Lazy.Char8 as B
 
 -- | An exception that can be thrown during a 'Haskell.LSP.Test.Session.Session'
-data SessionException = Timeout
+data SessionException = Timeout (Maybe FromServerMessage)
                       | NoContentLengthHeader
                       | UnexpectedMessage String FromServerMessage
                       | ReplayOutOfOrder FromServerMessage [FromServerMessage]
@@ -24,12 +24,16 @@ data SessionException = Timeout
 instance Exception SessionException
 
 instance Show SessionException where
-  show Timeout = "Timed out waiting to receive a message from the server."
+  show (Timeout lastMsg) =
+    "Timed out waiting to receive a message from the server." ++
+    case lastMsg of
+      Just msg -> "\nLast message received:\n" ++ B.unpack (encodePretty msg)
+      Nothing -> mempty
   show NoContentLengthHeader = "Couldn't read Content-Length header from the server."
   show (UnexpectedMessage expected lastMsg) =
     "Received an unexpected message from the server:\n" ++
     "Was parsing: " ++ expected ++ "\n" ++
-    "Last message received: " ++ show lastMsg
+    "Last message received:\n" ++ B.unpack (encodePretty lastMsg)
   show (ReplayOutOfOrder received expected) =
     let expected' = nub expected
         getJsonDiff = lines . B.unpack . encodePretty
index 67e4ae65d7d44175d244f882190146030a309e3e..ac4c9ff066bd5a3479b4b4181014954acc0acfa5 100644 (file)
@@ -91,15 +91,24 @@ instance MonadFail Session where
 -- | Stuff you can configure for a 'Session'.
 data SessionConfig = SessionConfig
   { messageTimeout :: Int  -- ^ Maximum time to wait for a message in seconds, defaults to 60.
-  , logStdErr      :: Bool -- ^ Redirect the server's stderr to this stdout, defaults to False.
-  , logMessages    :: Bool -- ^ Trace the messages sent and received to stdout, defaults to False.
+  , logStdErr      :: Bool
+  -- ^ Redirect the server's stderr to this stdout, defaults to False.
+  -- Can be overriden with @LSP_TEST_LOG_STDERR@.
+  , logMessages    :: Bool
+  -- ^ Trace the messages sent and received to stdout, defaults to False.
+  -- Can be overriden with the environment variable @LSP_TEST_LOG_MESSAGES@.
   , logColor       :: Bool -- ^ Add ANSI color to the logged messages, defaults to True.
   , lspConfig      :: Maybe Value -- ^ The initial LSP config as JSON value, defaults to Nothing.
+  , ignoreLogNotifications :: Bool
+  -- ^ Whether or not to ignore 'Language.Haskell.LSP.Types.ShowMessageNotification' and
+  -- 'Language.Haskell.LSP.Types.LogMessageNotification', defaults to False.
+  --
+  -- @since 0.9.0.0
   }
 
 -- | The configuration used in 'Language.Haskell.LSP.Test.runSession'.
 defaultConfig :: SessionConfig
-defaultConfig = SessionConfig 60 False False True Nothing
+defaultConfig = SessionConfig 60 False False True Nothing False
 
 instance Default SessionConfig where
   def = defaultConfig
@@ -181,15 +190,20 @@ runSession context state (Session session) = runReaderT (runStateT conduit state
 
     chanSource = do
       msg <- liftIO $ readChan (messageChan context)
+      unless (ignoreLogNotifications (config context) && isLogNotification msg) $
         yield msg
       chanSource
 
+    isLogNotification (ServerMessage (NotShowMessage _)) = True
+    isLogNotification (ServerMessage (NotLogMessage _)) = True
+    isLogNotification _ = False
+
     watchdog :: ConduitM SessionMessage FromServerMessage (StateT SessionState (ReaderT SessionContext IO)) ()
     watchdog = Conduit.awaitForever $ \msg -> do
       curId <- curTimeoutId <$> get
       case msg of
         ServerMessage sMsg -> yield sMsg
-        TimeoutMessage tId -> when (curId == tId) $ throw Timeout
+        TimeoutMessage tId -> when (curId == tId) $ lastReceivedMessage <$> get >>= throw . Timeout
 
 -- | An internal version of 'runSession' that allows for a custom handler to listen to the server.
 -- It also does not automatically send initialize and exit messages.
@@ -281,7 +295,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 file_ver t) = VirtualFile (fromMaybe oldV v) (file_ver + 1) t
           newVFS = updateVFS (Map.adjust update (toNormalizedUri uri)) oldVFS
       in s { vfs = newVFS }
 
@@ -290,7 +304,7 @@ updateState (ReqApplyWorkspaceEdit r) = do
           ctx <- ask
 
           -- if its not open, open it
-          unless (toNormalizedUri uri `Map.member` (vfsMap oldVFS)) $ do
+          unless (toNormalizedUri uri `Map.member` vfsMap oldVFS) $ do
             let fp = fromJust $ uriToFilePath uri
             contents <- liftIO $ T.readFile fp
             let item = TextDocumentItem (filePathToUri fp) "" 0 contents
@@ -362,3 +376,4 @@ logMsg t msg = do
 
         showPretty = B.unpack . encodePretty
 
+
index 1e8b3c24f725ba629b30abe796b15332ba195715..c3e341c587fe3ed24bd366874cb2d640e28142c8 100644 (file)
@@ -1,11 +1,3 @@
-resolver: lts-13.26
+resolver: nightly-2019-12-16
 packages:
   - .
-
-extra-deps:
-  - rope-utf16-splay-0.3.1.0
-  - github: alanz/haskell-lsp
-    commit: 2aacc5ca706bcce111e976a1af4a95a376137c5e
-    subdirs:
-      - .
-      - haskell-lsp-types
diff --git a/stack.yaml.lock b/stack.yaml.lock
deleted file mode 100644 (file)
index d72396d..0000000
+++ /dev/null
@@ -1,51 +0,0 @@
-# This file was autogenerated by Stack.
-# You should not edit this file by hand.
-# For more information, please see the documentation at:
-#   https://docs.haskellstack.org/en/stable/lock_files
-
-packages:
-- completed:
-    hackage: rope-utf16-splay-0.3.1.0@sha256:15a53c57f8413d193054bb5f045929edae3b2669def4c6af63197b30dc1d5003,2029
-    pantry-tree:
-      size: 667
-      sha256: 876b05bbbd1394bb862a7e2d460f6fe30f509c4c9a530530cb9fe7ec19a89c30
-  original:
-    hackage: rope-utf16-splay-0.3.1.0
-- completed:
-    size: 86224
-    subdir: .
-    url: https://github.com/alanz/haskell-lsp/archive/2aacc5ca706bcce111e976a1af4a95a376137c5e.tar.gz
-    cabal-file:
-      size: 5264
-      sha256: ddfcc2798f04bcb1ec20fafc02c03faa197322192578e879cef5852aba43ebcb
-    name: haskell-lsp
-    version: 0.17.0.0
-    sha256: fbbc3ebdbb2c0f6eacdb9f3c8a3550e71617aff9df279da175c8b99c422ddeb9
-    pantry-tree:
-      size: 5675
-      sha256: 80539460483f0459786fce73d842b203eef003fd1c657281daec8aea2957db3f
-  original:
-    subdir: .
-    url: https://github.com/alanz/haskell-lsp/archive/2aacc5ca706bcce111e976a1af4a95a376137c5e.tar.gz
-- completed:
-    size: 86224
-    subdir: haskell-lsp-types
-    url: https://github.com/alanz/haskell-lsp/archive/2aacc5ca706bcce111e976a1af4a95a376137c5e.tar.gz
-    cabal-file:
-      size: 2941
-      sha256: 9078237412d0596a7d09d432389c8fa21d6f3e21ed2ed761b3093a21607d6c28
-    name: haskell-lsp-types
-    version: 0.17.0.0
-    sha256: fbbc3ebdbb2c0f6eacdb9f3c8a3550e71617aff9df279da175c8b99c422ddeb9
-    pantry-tree:
-      size: 2501
-      sha256: a575ce26976bd31d34a9db27e20e8e34d9b50b8d2e34a2e3772b3236b8cf778c
-  original:
-    subdir: haskell-lsp-types
-    url: https://github.com/alanz/haskell-lsp/archive/2aacc5ca706bcce111e976a1af4a95a376137c5e.tar.gz
-snapshots:
-- completed:
-    size: 499889
-    url: https://raw.githubusercontent.com/commercialhaskell/stackage-snapshots/master/lts/13/26.yaml
-    sha256: ecb02ee16829df8d7219e7d7fe6c310819820bf335b0b9534bce84d3ea896684
-  original: lts-13.26
index 22f8e21996df80c4b9e9a81b95d07edbab5e72d3..ed8c6b5f5f0c6ce0e8d2b88fd8bbe40bcf0f7efb 100644 (file)
@@ -93,7 +93,9 @@ main = hspec $ do
                 getDocumentSymbols doc
                 -- should now timeout
                 skipManyTill anyMessage message :: Session ApplyWorkspaceEditRequest
-        in sesh `shouldThrow` (== Timeout)
+            isTimeout (Timeout _) = True
+            isTimeout _ = False
+        in sesh `shouldThrow` isTimeout
 
 
     describe "SessionException" $ do
@@ -333,6 +335,12 @@ main = hspec $ do
           pred _ = False
       void $ satisfy pred
 
+  describe "ignoreLogNotifications" $
+    it "works" $
+      runSessionWithConfig (defaultConfig { ignoreLogNotifications = True }) "hie"  fullCaps "test/data" $ do
+        openDoc "Format.hs" "haskell"
+        void publishDiagnosticsNotification
+
 mkRange sl sc el ec = Range (Position sl sc) (Position el ec)
 
 didChangeCaps :: ClientCapabilities