lsp-test 0.14.0.1 → 0.14.0.2
raw patch · 8 files changed
+83/−21 lines, 8 filesdep ~basedep ~lspdep ~lsp-typesnew-uploader
Dependency ranges changed: base, lsp, lsp-types
Files
- ChangeLog.md +4/−0
- lsp-test.cabal +5/−7
- src/Language/LSP/Test.hs +3/−1
- src/Language/LSP/Test/Decoding.hs +1/−1
- src/Language/LSP/Test/Parsing.hs +1/−0
- src/Language/LSP/Test/Session.hs +13/−8
- test/DummyServer.hs +24/−3
- test/Test.hs +32/−1
ChangeLog.md view
@@ -1,5 +1,9 @@ # Revision history for lsp-test +## 0.14.0.2 ++* Compatibility with new lsp-types major version.+ ## 0.14.0.1 -- 2021-07-30 * Catch IO exception when sending messages to server (#317) (@berberman)
lsp-test.cabal view
@@ -1,6 +1,6 @@ cabal-version: 2.4 name: lsp-test-version: 0.14.0.1+version: 0.14.0.2 synopsis: Functional test framework for LSP servers. description: A test framework for writing tests against@@ -36,7 +36,7 @@ , parser-combinators:Control.Applicative.Combinators default-language: Haskell2010 build-depends: base >= 4.10 && < 5- , lsp-types == 1.3.*+ , lsp-types == 1.4.* , aeson , time , aeson-pretty@@ -81,7 +81,7 @@ build-depends: base >= 4.10 && < 5 , hspec , lens- , lsp == 1.2.*+ , lsp == 1.4.* , lsp-test , data-default , aeson@@ -99,15 +99,13 @@ main-is: FuncTest.hs hs-source-dirs: func-test type: exitcode-stdio-1.0- build-depends: base <4.16+ build-depends: base , lsp-test , lsp- , data-default , process , lens , unliftio , hspec- , async default-language: Haskell2010 test-suite example@@ -124,7 +122,7 @@ main-is: SimpleBench.hs hs-source-dirs: bench type: exitcode-stdio-1.0- build-depends: base <4.16+ build-depends: base , lsp-test , lsp , process
src/Language/LSP/Test.hs view
@@ -198,7 +198,9 @@ config <- envOverrideConfig config' let initializeParams = InitializeParams Nothing- (Just pid)+ -- Narowing to Int32 here, but it's unlikely that a pid will+ -- be outside the range+ (Just $ fromIntegral pid) (Just lspTestClientInfo) (Just $ T.pack absRootDir) (Just $ filePathToUri absRootDir)
src/Language/LSP/Test/Decoding.hs view
@@ -82,7 +82,7 @@ Just m -> Just $ (m, Pair m (Const newMap)) unP (Success (FromServerMess m msg)) = (reqMap, FromServerMess m msg) unP (Success (FromServerRsp (Pair m (Const newMap)) msg)) = (newMap, FromServerRsp m msg)- unP (Error e) = error e+ unP (Error e) = error $ "Error decoding " <> show obj <> " :" <> e {- WorkspaceWorkspaceFolders -> error "ReqWorkspaceFolders not supported yet" WorkspaceConfiguration -> error "ReqWorkspaceConfiguration not supported yet"
src/Language/LSP/Test/Parsing.hs view
@@ -198,6 +198,7 @@ shouldSkip (FromServerMess SWindowLogMessage _) = True shouldSkip (FromServerMess SWindowShowMessage _) = True shouldSkip (FromServerMess SWindowShowMessageRequest _) = True+ shouldSkip (FromServerMess SWindowShowDocument _) = True shouldSkip _ = False -- | Matches a 'Language.LSP.Types.TextDocumentPublishDiagnostics'
src/Language/LSP/Test/Session.hs view
@@ -169,7 +169,7 @@ data SessionState = SessionState {- curReqId :: !Int+ curReqId :: !Int32 , vfs :: !VFS , curDiagnostics :: !(Map.Map NormalizedUri [Diagnostic]) , overridingTimeout :: !Bool@@ -231,6 +231,7 @@ isLogNotification (ServerMessage (FromServerMess SWindowShowMessage _)) = True isLogNotification (ServerMessage (FromServerMess SWindowLogMessage _)) = True+ isLogNotification (ServerMessage (FromServerMess SWindowShowDocument _)) = True isLogNotification _ = False watchdog :: ConduitM SessionMessage FromServerMessage (StateT SessionState (ReaderT SessionContext IO)) ()@@ -307,7 +308,7 @@ respond (FromServerMess SWindowWorkDoneProgressCreate req) = sendMessage $ ResponseMessage "2.0" (Just $ req ^. LSP.id) (Right Empty) respond (FromServerMess SWorkspaceApplyEdit r) = do- sendMessage $ ResponseMessage "2.0" (Just $ r ^. LSP.id) (Right $ ApplyWorkspaceEditResponseBody True Nothing)+ sendMessage $ ResponseMessage "2.0" (Just $ r ^. LSP.id) (Right $ ApplyWorkspaceEditResponseBody True Nothing Nothing) respond _ = pure () @@ -353,7 +354,10 @@ allChangeParams <- case r ^. params . edit . documentChanges of Just (List cs) -> do mapM_ (checkIfNeedsOpened . documentChangeUri) cs- return $ mapMaybe getParamsFromDocumentChange cs+ -- replace the user provided version numbers with the VFS ones + 1+ -- (technically we should check that the user versions match the VFS ones)+ cs' <- traverseOf (traverse . _InL . textDocument) bumpNewestVersion cs+ return $ mapMaybe getParamsFromDocumentChange cs' -- Then fall back to the changes field Nothing -> case r ^. params . edit . changes of Just cs -> do@@ -375,12 +379,11 @@ -- Update VFS to new document versions let sortedVersions = map (sortBy (compare `on` (^. textDocument . version))) groupedParams latestVersions = map ((^. textDocument) . last) sortedVersions- bumpedVersions = map (version . _Just +~ 1) latestVersions - forM_ bumpedVersions $ \(VersionedTextDocumentIdentifier uri v) ->+ forM_ latestVersions $ \(VersionedTextDocumentIdentifier uri v) -> modify $ \s -> let oldVFS = vfs s- update (VirtualFile oldV file_ver t) = VirtualFile (fromMaybe oldV v) (file_ver + 1) 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 } @@ -400,7 +403,7 @@ return $ s { vfs = newVFS } getParamsFromTextDocumentEdit :: TextDocumentEdit -> DidChangeTextDocumentParams- getParamsFromTextDocumentEdit (TextDocumentEdit docId (List edits)) =+ getParamsFromTextDocumentEdit (TextDocumentEdit docId (List edits)) = do DidChangeTextDocumentParams docId (List $ map editToChangeEvent edits) editToChangeEvent :: TextEdit |? AnnotatedTextEdit -> TextDocumentContentChangeEvent@@ -411,6 +414,8 @@ getParamsFromDocumentChange (InL textDocumentEdit) = Just $ getParamsFromTextDocumentEdit textDocumentEdit getParamsFromDocumentChange _ = Nothing + bumpNewestVersion (VersionedTextDocumentIdentifier uri _) =+ head <$> textDocumentVersions uri -- For a uri returns an infinite list of versions [n,n+1,n+2,...] -- where n is the current version@@ -424,7 +429,7 @@ vers <- textDocumentVersions uri pure $ map (\(v, e) -> TextDocumentEdit v (List [InL e])) $ zip vers edits - getChangeParams uri (List edits) = do + getChangeParams uri (List edits) = do map <$> pure getParamsFromTextDocumentEdit <*> textDocumentEdits uri (reverse edits) mergeParams :: [DidChangeTextDocumentParams] -> DidChangeTextDocumentParams
test/DummyServer.hs view
@@ -139,15 +139,36 @@ do Just token <- runInIO $ asks absRegToken >>= tryReadMVar runInIO $ unregisterCapability token++ -- this handler is used by the+ -- "text document VFS / sends back didChange notifications (documentChanges)" test+ , notificationHandler STextDocumentDidChange $ \noti -> do+ let NotificationMessage _ _ params = noti+ void $ sendNotification (SCustomMethod "custom/textDocument/didChange") (toJSON params)+ , requestHandler SWorkspaceExecuteCommand $ \req resp -> do- let RequestMessage _ _ _ (ExecuteCommandParams Nothing "doAnEdit" (Just (List [val]))) = req+ case req of+ RequestMessage _ _ _ (ExecuteCommandParams Nothing "doAnEdit" (Just (List [val]))) -> do+ let Success docUri = fromJSON val edit = List [TextEdit (mkRange 0 0 0 5) "howdy"] params = ApplyWorkspaceEditParams (Just "Howdy edit") $ WorkspaceEdit (Just (HM.singleton docUri edit)) Nothing Nothing- resp $ Right Null- void $ sendRequest SWorkspaceApplyEdit params (const (pure ()))+ resp $ Right Null+ void $ sendRequest SWorkspaceApplyEdit params (const (pure ()))+ RequestMessage _ _ _ (ExecuteCommandParams Nothing "doAVersionedEdit" (Just (List [val]))) -> do+ let+ Success versionedDocUri = fromJSON val+ edit = List [InL (TextEdit (mkRange 0 0 0 5) "howdy")]+ documentEdit = TextDocumentEdit versionedDocUri edit+ params =+ ApplyWorkspaceEditParams (Just "Howdy edit") $+ WorkspaceEdit Nothing (Just (List [InL documentEdit])) Nothing+ resp $ Right Null+ void $ sendRequest SWorkspaceApplyEdit params (const (pure ()))+ RequestMessage _ _ _ (ExecuteCommandParams _ name _) ->+ error $ "unsupported command: " <> show name , requestHandler STextDocumentCodeAction $ \req resp -> do let RequestMessage _ _ _ params = req CodeActionParams _ _ _ _ cactx = params
test/Test.hs view
@@ -2,6 +2,7 @@ {-# LANGUAGE GADTs #-} {-# LANGUAGE DuplicateRecordFields #-} {-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE DeriveAnyClass #-} @@ -132,7 +133,37 @@ in runSessionWithHandles hin hout def fullCaps "." sesh `shouldThrow` selector - describe "text document VFS" $+ describe "text document VFS" $ do+ it "sends back didChange notifications (documentChanges)" $ \(hin, hout) ->+ runSessionWithHandles hin hout def fullCaps "." $ do+ doc <- openDoc "test/data/refactor/Main.hs" "haskell"+ VersionedTextDocumentIdentifier _ beforeVersion <- getVersionedDoc doc++ let args = toJSON (VersionedTextDocumentIdentifier (doc ^. uri) beforeVersion)+ reqParams = ExecuteCommandParams Nothing "doAVersionedEdit" (Just (List [args]))++ request_ SWorkspaceExecuteCommand reqParams++ editReq <- message SWorkspaceApplyEdit+ liftIO $ do+ let Just (List [InL(TextDocumentEdit vdoc (List [InL edit_]))]) =+ editReq ^. params . edit . documentChanges+ vdoc `shouldBe` VersionedTextDocumentIdentifier (doc ^. uri) beforeVersion+ edit_ `shouldBe` TextEdit (Range (Position 0 0) (Position 0 5)) "howdy"++ change <- customNotification "custom/textDocument/didChange"+ let NotMess (NotificationMessage _ _ (c::Value)) = change+ Success (DidChangeTextDocumentParams reportedVDoc _edit) = fromJSON c+ VersionedTextDocumentIdentifier _ reportedVersion = reportedVDoc++ contents <- documentContents doc++ liftIO $ contents `shouldBe` "howdy:: IO Int\nmain = return (42)\n"+ VersionedTextDocumentIdentifier _ afterVersion <- getVersionedDoc doc+ liftIO $ afterVersion `shouldNotBe` beforeVersion++ liftIO $ reportedVersion `shouldNotBe` beforeVersion+ it "sends back didChange notifications" $ \(hin, hout) -> runSessionWithHandles hin hout def fullCaps "." $ do doc <- openDoc "test/data/refactor/Main.hs" "haskell"